From owner-freebsd-cvsweb@FreeBSD.ORG Mon Aug 16 09:04:22 2004 Return-Path: Delivered-To: freebsd-cvsweb@freebsd.org Received: from mx1.FreeBSD.org (mx1.freebsd.org [216.136.204.125]) by hub.freebsd.org (Postfix) with ESMTP id D387016A4D1 for ; Mon, 16 Aug 2004 09:04:22 +0000 (GMT) Received: from mail.iem.gov.tr (mail.iem.gov.tr [212.15.21.180]) by mx1.FreeBSD.org (Postfix) with SMTP id 3EC7643D53 for ; Mon, 16 Aug 2004 09:04:00 +0000 (GMT) (envelope-from mesutgl@iem.gov.tr) Received: (qmail 64603 invoked by uid 0); 16 Aug 2004 09:06:21 -0000 Received: from unknown (HELO Mesut) (192.0.0.9) by 0 with SMTP; 16 Aug 2004 09:06:21 -0000 Message-ID: <06d401c4836f$e2b4e150$090000c0@Mesut> From: =?iso-8859-9?Q?Mesut_G=DCLNAZ?= To: Date: Mon, 16 Aug 2004 12:03:24 +0300 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_06D0_01C48389.07F63270" X-Priority: 3 X-MSMail-Priority: Normal X-Mailer: Microsoft Outlook Express 6.00.2800.1437 X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1441 X-Mailman-Approved-At: Mon, 16 Aug 2004 11:54:28 +0000 X-Content-Filtered-By: Mailman/MimeDel 2.1.1 Subject: where is my mistake? X-BeenThere: freebsd-cvsweb@freebsd.org X-Mailman-Version: 2.1.1 Precedence: list List-Id: CVS Web maintenance mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 16 Aug 2004 09:04:23 -0000 This is a multi-part message in MIME format. ------=_NextPart_000_06D0_01C48389.07F63270 Content-Type: text/plain; charset="iso-8859-9" Content-Transfer-Encoding: quoted-printable where is my mistake? thank u very much! ------=_NextPart_000_06D0_01C48389.07F63270 Content-Type: application/octet-stream; name="session.log" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="session.log" su-2.05b# uname FreeBSD su-2.05b# cat /usr/local/etc/apache/httpd.conf | grep DocumentRoot # DocumentRoot: The directory out of which you will serve your DocumentRoot "/usr/local/www/cgi-bin" # This should be changed to whatever you set DocumentRoot to. # even if you change the DocumentRoot. Comment it if you don't want = to=20 # DocumentRoot /www/docs/dummy-host.example.com su-2.05b# ls -l /usr/local/www/cgi-bin total 116 -r-xr-xr-x 1 root wheel 96643 Aug 13 17:12 cvsweb.cgi -r--r--r-- 1 root www 15972 Aug 16 11:39 cvsweb.conf -r--r--r-- 1 root www 848 Aug 16 11:20 cvsweb.conf-freebsd drwxr-xr-x 3 www www 512 Aug 13 17:01 usr su-2.05b# ls -l /usr/local/www/ =20 total 14 drwxr-xr-x 3 www www 512 Aug 16 11:39 cgi-bin drwxr-xr-x 2 root wheel 512 Aug 13 13:02 cgi-bin-dist drwxr-xr-x 2 root wheel 512 Aug 13 15:03 data drwxr-xr-x 2 root wheel 1024 Aug 13 14:42 data-dist drwxr-xr-x 4 root wheel 3584 Aug 13 17:12 icons drwxr-xr-x 2 www www 512 Aug 13 13:02 proxy su-2.05b# cat /usr/local/www/cgi-bin/cvsweb.conf # -*-perl-*- # Configuration of cvsweb.cgi, the # CGI interface to CVS Repositories. # # (c) 1998-1999 H. Zeller # 1999 H. Nordstrom # 2000-2002 A. MUSHA # 2002 V. Skytt=E4 # based on work by Bill Fenner # # $FreeBSD: projects/cvsweb/cvsweb.conf,v 1.36.2.3 2002/09/23 05:30:17 = scop Exp $ # $Id: cvsweb.conf,v 1.29 2001/07/23 09:14:52 hzeller Exp $ # $Idaemons: /home/cvs/cvsweb/cvsweb.conf,v 1.27 2001/08/01 09:48:39 knu = Exp $ # ### # Set the path for the following commands: # uname, cvs, rlog, rcsdiff # gzip (if you enable $allow_compress) # tar, rm, zip (if you enable $allow_tar) $command_path =3D '/bin:/usr/bin:/usr/local/bin'; # Search the above directories for each command for (qw(uname cvs rlog rcsdiff gzip tar rm zip)) { $CMD{$_} =3D search_path($_); } # The name of the operating system implementation chomp($uname =3D `$CMD{uname}`); ############## # CVS Root ############## # CVSweb can handle several CVS-Repositories # at once. Enter a short symbolic names and the # full path of these repositories here. # NOTE that the symbolic names may not contain # whitespaces. # Note, that cvsweb.cgi currently needs to have physical access # to the CVS repository so :pserver:someone@xyz.com:/data/cvsroot # won't work! # 'symbolic_name' =3D> ['name_to_display', = 'path_to_the_actual_repository'] # Listed in the order specified: @CVSrepositories =3D ( 'local' =3D> ['My CVS Repository', '/usr/bin/cvs'], # 'freebsd' =3D> ['FreeBSD', '/home/ncvs'], # 'openbsd' =3D> ['OpenBSD', '/home/ncvs'], # 'netbsd' =3D> ['NetBSD', '/home/ncvs'], # 'ruby' =3D> ['Ruby', '/var/anoncvs/ruby'], ); # This tree is enabled by default when # you enter the page $cvstreedefault =3D $CVSrepositories[2 * 0]; # The first one ############## # Bug tracking system options # ("PR" means Problem Report, as in GNATS) ############## #@prcategories =3D qw( # advocacy # alpha # bin # conf # docs # gnu # i386 # kern # misc # pending # ports # sparc #); # #$prcgi =3D "http://www.FreeBSD.org/cgi/query-pr.cgi?pr=3D%s"; # #$prkeyword =3D "PR"; ############## # Manual gateway ############## $mancgi =3D = "http://www.FreeBSD.org/cgi/man.cgi?apropos=3D0&sektion=3D%s&query=3D%s&m= anpath=3DFreeBSD+5.0-current&format=3Dhtml"; ############## # Defaults for UserSettings ############## %DEFAULTVALUE =3D ( # sortby: File sort order # file Sort by filename # rev Sort by revision number # date Sort by commit date # author Sort by author # log Sort by log message "sortby" =3D> "file", # hideattic: Hide or show files in Attic # 1 Hide files in Attic # 0 Show files in Attic "hideattic" =3D> "1", # logsort: Sort order for CVS logs # date Sort revisions by date # rev Sort revision by revision number # cvs Don't sort them. Same order as CVS/RCS shows them. "logsort" =3D> "date", # f: Default diff format # h Human readable # u Unified diff # c Context diff # s Side by side "f" =3D> "u", # hidecvsroot: Don't show the CVSROOT directory # 1 Hide CVSROOT directory # 0 Show CVSROOT directory "hidecvsroot" =3D> "0", # hidenonreadable: Don't show entries which cannot be read # 1 Hide non-readable entries # 0 Show non-readable entries "hidenonreadable" =3D> "1", ); ############## # some layout stuff ############## # The body-tag for directory views and logs $body_tag =3D ''; # The body-tag for diffs and annotations $body_tag_for_src =3D ''; # Wanna have a logo on the page ? $logo =3D '

3D"Powered

'; # The title of the Page on startup. This will be put inside a

tag. $defaulttitle =3D "CVS Repository"; # The address is shown on the footer. This will be put inside a =
tag. $address =3D 'FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org= >'; # color of navigation Header for # diffs and annotations $navigationHeaderColor =3D '#9999ee'; $long_intro =3D < This is a WWW interface for CVS Repositories. You can browse the file hierarchy by picking directories (which have slashes after them, e.g., src/). If you pick a file, you will see the revision history for that file. Selecting a revision number will download that revision of the file. There is a link at each revision to display diffs between that revision and the previous one, and a form at the bottom of the page that allows you to display diffs between arbitrary revisions.

This script has been written by Bill Fenner and improved by Henner = Zeller, Henrik Nordström, and Ken Coar, then Akinori MUSHA brought it back to FreeBSD community and made further improvements; it is covered by The BSD = Licence.

If you would like to use this CGI script on your own web server and CVS tree, download the latest version from <URL:http://www.FreeBSD.o= rg/projects/cvsweb.html>.

Feel free to send any patches, suggestions and comments to the = FreeBSD-CVSweb mailing list at <freebsd-cvsweb\@FreeBSD.org>.

EOT $short_instruction =3D < Click on a directory to enter that directory. Click on a file to display its revision history and to get a chance to display diffs between = revisions.

EOT # used icons; if icon-url is empty, the text representation is used; if # you do not want to have an ugly tooltip for the icon, remove the # text-representation. # The width and height of the icon allow the browser to correcly display # the table while still loading the icons. # These default icons are coming with apache. # If these icons are too large, check out the miniicons in the # icons/ directory; they have a width/height of 16/16 my $iconsdir =3D "/icons/cvsweb"; # format: TEXT ICON-URL width height %ICONS =3D ( back =3D> [("[BACK]", "$iconsdir/back.gif", 20, 22)], dir =3D> [("[DIR]", "$iconsdir/dir.gif", 20, 22)], file =3D> [("[TXT]", "$iconsdir/text.gif", 20, 22)], ); undef $iconsdir; # the length to which the last logentry should # be truncated when shown in the directory view $shortLogLen =3D 80; # Show author of last change $show_author =3D 1; ############## # table view for directories ############## # Show directory as table # this is much more readable but has one # drawback: the whole table has to be loaded # before common browsers display it which may # be annoying if you have a slow link - and a # large directory .. $dirtable =3D 1; # show different colors for even/odd rows @tabcolors =3D ('#ffffff', '#ffffff'); $tablepadding =3D 2; # Color of Header $columnHeaderColorDefault =3D '#ffffcc'; $columnHeaderColorSorted =3D '#ffcc66'; #=20 # If you want to have colored borders=20 # around each row, uncomment this $tableBorderColor =3D '#cccccc'; # # Modules in the repository that should not be displayed, either by = default # nor by explicit path specification. # @HideModules =3D ( # "^my/secret/module", ); # # Files matching these pathnames shouldn't be checked out with cvsweb, # since they may contain sensitive information. Simple file name based # filter. Often, the CVSROOT/passwd is exposed and some people tend # to check in their .cvspass, though this is a bad idea. These files # shouldn't be readable by default. Thanks to Damian Gryski to point # this out. # Note that this affects only files, not directories. @ForbiddenFiles =3D ( "^CVSROOT/passwd\$", # CVSROOT/passwd should not be cvs = add'ed, though "/\\.cvspass\$", # Ditto. Just in case. ); # # Use CVSROOT/CVSROOT/descriptions for describing the = directories/modules # See INSTALL section 8 # $use_descriptions =3D 0; ############## # Human Readable Diff ############## # (c) 1998 H. Zeller # # Generates two columns of color encoded # diff; much like xdiff or emacs-ediff mode. # # The diff-stuff is a piece of code I once made for # cvs2html which is under GPL, # see http://www.sslug.dk/cvs2html # (c) 1997/98 Peter Toft # # some parameters to screw: ## # make lines breakable so that the columns do not # exceed the width of the browser $hr_breakable =3D 1; # give out function names in diffs # this just makes sense if we have C-files, otherwise # diff's heuristic doesn't work well .. # ( '-p' option to diff) $showfunc =3D 1; # For each pair of regexps, files that match the first regexp will be = diff'ed # with an '-F' option with the second regexp. %funcline_regexp =3D ( "\\.(4th|fr)\$" =3D> "\\(^\\|[ \t]\\): ", "\\.rb\$" =3D> "^[\t ]*\\(class\\|module\\|def\\) ", ); # ignore whitespaces for human readable diffs # (indendation and stuff ..) # ( '-w' option to diff) $hr_ignwhite =3D 0; # ignore diffs which are caused by # keyword-substitution like $Id - Stuff # ( '-kk' option to rcsdiff) $hr_ignkeysubst =3D 1; # Colors and font to show the diff type of code changes $diffcolorHeading =3D '#99cccc'; # color of 'Line'-head of each = diffed file $diffcolorEmpty =3D '#cccccc'; # color of 'empty' lines $diffcolorRemove =3D '#ff9999'; # Removed line(s) (left) ( - ) $diffcolorChange =3D '#99ff99'; # Changed line(s) ( both ) $diffcolorAdd =3D '#ccccff'; # Added line(s) ( - ) (right) $diffcolorDarkChange =3D '#99cc99'; # lines, which are empty in = change $difffontface =3D "Helvetica,Arial"; $difffontsize =3D "-1"; # the width of the textinput of the # request-diff-form $inputTextSize =3D 12; ############## # Mime Types ############## # mapping to mimetypes to help # cvsweb to guess the correct mime-type on # checkout; you can use the mime.types from # apache here: $mime_types =3D '/usr/local/etc/apache/mime.types'; # quick mime-type lookup; maps file-suffices to # mime-types for displaying checkouts in the browser. # Further MimeTypes will be found in the=20 # file $mime_types (apache style mime.types - file) # - add common mappings here for faster lookup %MTYPES =3D ( "html" =3D> "text/html", "shtml" =3D> "text/html", "gif" =3D> "image/gif", "jpeg" =3D> "image/jpeg", "jpg" =3D> "image/jpeg", "png" =3D> "image/png", "xpm" =3D> "image/xpm", "*" =3D> "text/plain", ); # Charset for HTML output $charset =3D ''; # e.g. #$charset =3D $where =3D~ m,/ru[/_-], ? 'koi8-r' # : $where =3D~ m,/zh[/_-], ? 'big5' # : $where =3D~ m,/ja[/_-], ? 'x-euc-jp' # : $where =3D~ m,/ko[/_-], ? 'x-euc-kr' # : 'iso-8859-1'; # Output filter $output_filter =3D ''; # e.g. ## unify/convert Japanese code into EUC-JP #$output_filter=3D '/usr/local/bin/nkf -e'; ############## # Misc ############## # allow annotation of files # this requires rw-access to the # CVSROOT/history file (if you have one) # and rw-access to the subdirectory to # place the lock so you maybe don't want it $allow_annotate =3D 1; # allow pretty-printed version of files $allow_markup =3D 1; # allow extra hlink formatting (such as PR xrefs) in logs $allow_log_extra =3D 1; # default: enabled # allow extra hlink formatting (such as PR xrefs) in directories $allow_dir_extra =3D 1; # allow extra hlink formatting in source code/formatted diff views $allow_source_extra =3D 1; # allow compression with gzip # of output if the Browser accepts # it (HTTP_ACCEPT_ENCODING=3Dgzip) # [make sure to have gzip in the path] $allow_compress =3D 0; # Make use of javascript functions. # This way you can select one of your CVSroot # without pressing 'Go' (.. if you do have more # than one CVSROOT defined) $use_java_script =3D 1; # open Download-Links in another window $open_extern_window =3D 1; # The size of this extern window; this size option # needs use_java_script to be defined # just comment them if you don't want to have a fixed # size #$extern_window_width =3D 600; #$extern_window_height =3D 440; # Edit Options # Enable form to edit your options (hideattic,sortbydate) # this isn't necessary if you've $dirtable defined 'cause # this allows editing of all your options more intuitive $edit_option_form =3D (not $dirtable); # If you have files which automatically refers to other files # (such as HTML) then this allows you to browse the checked # out files as if outside CVS. $checkout_magic =3D 1; # Show last changelog message for sub directories # The current implementation makes many assumptions and may show the # incorrect file at some times. The main assumption is that the last # modified file has the newest filedate. But some CVS operations # touches the file without even when a new version is't checked in, # and TAG based browsing essientially puts this out of order, unless # the last checkin was on the same tag as you are viewing. # Enable this if you like the feature, but don't rely on correct = results. $show_subdir_lastmod =3D 0; # Background color of logentry in markup $markupLogColor =3D "#ffffff"; # Show CVS log when viewing file contents $show_log_in_markup =3D 1; # Preformat when viewing file contents. This should be turned off # when you have files in the repository that are in a multibyte # encoding which uses HTML special characters ([<>&"]) as part of a # multi-byte character. (such as iso-2022-jp, ShiftJIS, etc.) # Otherwise those files will get screwed up in markup. $preformat_in_markup =3D ''; # Tabstop used to expand tabs in colored diffs. If undefined then # tabs are always expanded to 8 spaces. $tabstop =3D 8; # if you wish to display absolute times in your local timezone, # then define mytz and fill in the strings for your standard and # daylight time. Note that you must also make sure the system # timezone is correctly set. # @mytz=3D("EST", "EDT"); # cvsweb is friendly to caches by indicating a suitable # last-modified timestamp. Doing this uses slightly more # CPU so you might want to disable it if you have a slow # server $use_moddate =3D 1; # Allows downloading a tarball of the current directory if set. # Bear in mind that this allows downloading a tarball of your entire # repository, which can take a lot of time and disk space to create! # If you enable this, you may need to make sure that cvsweb can write to # CVSROOT/val-tags, due to a bug in cvs. $allow_tar =3D ''; # Options to pass to tar(1). @tar_options =3D qw(--ignore-failed-read); # e.g. @tar_options =3D qw(--ignore-failed-read); # GNU tar has some useful options against unexpected errors. # Options to pass to gzip(1) when compressing a tarball to download. @gzip_options =3D qw(); # e.g. @gzip_options =3D qw(-3); # Try lower compression level than 6 (default) if you want faster # compression, or higher, for better compression. # Options to pass to zip(1) when compressing a zip archive to download. @zip_options =3D qw(); # e.g. @zip_options =3D qw(-3); # Try lower compression level than 6 (default) if you want faster # compression, or higher, for better compression. # Options to pass to cvs(1). # For cvs versions prior to 1.11, the '-l' option doesn't work; If you = want # working checkouts with an older cvs version, you'll have to make sure = that # the cvsweb user can read and write to CVSROOT/history. @cvs_options =3D qw(-lf); push @cvs_options, '-R' if ($uname eq 'FreeBSD' || $uname eq 'OpenBSD'); push @cvs_options, '-u' if ($uname eq 'NetBSD'); # Only FreeBSD's and OpenBSD's cvs(1) supports -R (read only access # mode) option, which considerably speeds up checkouts over NFS. # A similar effect is provided by -u on NetBSD. # Options to pass to the 'cvs annotate' command, usually the normal # @cvs_options are good enough here. @annotate_options =3D @cvs_options; # To make annotate work against a read only repository, add -n, = e.g.: # @annotate_options =3D (@cvs_options, '-n'); 1; #EOF su-2.05b# cat /usr/local/www/cgi-bin/cvsweb.conf-freebsd=20 # -*-perl-*- # # Set up for FreeBSD repo options. # # $FreeBSD: projects/cvsweb/cvsweb.conf-freebsd,v 1.7 2001/11/07 = 20:37:56 knu Exp $ # $Idaemons: /home/cvs/cvsweb/cvsweb.conf-freebsd,v 1.5 2001/08/01 = 09:32:22 knu Exp $ if ($uname eq 'FreeBSD') { $ENV{'RCSLOCALID'} =3D 'FreeBSD=3DCVSHeader'; $ENV{'RCSINCEXC'} =3D 'iFreeBSD'; } else { $ENV{'RCSLOCALID'} =3D 'FreeBSD'; } @prcategories =3D qw( advocacy alpha bin conf docs gnu i386 kern misc pending ports sparc ); $prcgi =3D "http://www.FreeBSD.org/cgi/query-pr.cgi?pr=3D%s"; $prkeyword =3D "PR"; $mancgi =3D = "http://www.FreeBSD.org/cgi/man.cgi?apropos=3D0&sektion=3D%s&query=3D%s&m= anpath=3DFreeBSD+5.0-current&format=3Dhtml"; # Allow downloading a tarball of a port or a project directory $allow_tar =3D ($where =3D~ m,^(ports/[^/]+/[^/]+/|projects/[^/]+/),); 1; su-2.05b# cat /usr/local/www/cgi-bin/cvsweb.cgi =20 #!/usr/bin/perl -w # # cvsweb - a CGI interface to CVS trees. # # Written in their spare time by # Bill Fenner (original = work) # extended by Henner Zeller , # Henrik Nordstrom # Ken Coar # Dick Balaska # Akinori MUSHA # Jens-Uwe Mager # Ville Skytt=E4 # Vassilii Khachaturov # # Based on: # * Bill Fenners cvsweb.cgi revision 1.28 available from: # http://www.FreeBSD.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi # # Copyright (c) 1996-1998 Bill Fenner # (c) 1998-1999 Henner Zeller # (c) 1999 Henrik Nordstrom # (c) 2000-2002 Akinori MUSHA # (c) 2002 Ville Skytt=E4 # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the = distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR = PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE = LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR = CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE = GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, = STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY = WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.119.2.6 2002/09/26 20:56:05 = scop Exp $ # $Id: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $ # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu = Exp $ # ### require 5.000; use strict; use vars qw ( $cvsweb_revision $mydir $uname $config $allow_version_select $verbose @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted %symrev %revsym @allrevisions %date %author @revdisplayorder @revisions %state %difflines %log %branchpoint @revorder $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword = $mancgi $checkoutMagic $doCheckout $scriptname $scriptwhere $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars @unsafevars %funcline_regexp $is_mod_perl $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased %input $query $barequery $sortby $bydate $byrev $byauthor $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot $mimetype $charset $output_filter $defaultTextPlain $defaultViewable $command_path %CMD $allow_compress $backicon $diricon $fileicon $fullname $newname $cvstreedefault $body_tag $body_tag_for_src $logo $defaulttitle $address $long_intro $short_instruction $shortLogLen $show_author $dirtable $tablepadding $columnHeaderColorDefault $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface $difffontsize $inputTextSize $mime_types $allow_annotate $allow_markup $allow_log_extra $allow_dir_extra $allow_source_extra $use_java_script $open_extern_window $extern_window_width $extern_window_height $edit_option_form $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v $navigationHeaderColor $tableBorderColor $markupLogColor $tabstop $state $annTable $sel $curbranch @HideModules = @ForbiddenFiles $module $use_descriptions %descriptions @mytz $dwhere $moddate $use_moddate $has_zlib $gzip_open $allow_tar @tar_options @gzip_options @zip_options @cvs_options @annotate_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR $tmpdir $HTML_DOCTYPE $HTML_META ); sub printDiffSelect($); sub printDiffLinks($$); sub printLogSortSelect($); sub findLastModifiedSubdirs(@); sub htmlify_sub(&$); sub htmlify($;$); sub spacedHtmlText($;$); sub link($$); sub revcmp($$); sub fatal($$@); sub redirect($); sub safeglob($); sub search_path($); sub getMimeTypeFromSuffix($); sub head($;$); sub scan_directives(@); sub openOutputFilter(); sub doAnnotate($$); sub doCheckout($$); sub cvswebMarkup($$$); sub viewable($); sub doDiff($$$$$$); sub getDirLogs($$@); sub readLog($;$); sub printLog($;$); sub doLog($); sub flush_diff_rows($$$$); sub human_readable_diff($); sub navigateHeader($$$$$); sub plural_write($$); sub readableTime($$); sub clickablePath($$); sub chooseCVSRoot(); sub chooseMirror(); sub fileSortCmp(); sub download_url($$;$); sub download_link($$$;$); sub toggleQuery($$); sub urlencode($); sub htmlquote($); sub htmlunquote($); sub hrefquote($); sub http_header(;$); sub html_header($); sub html_footer(); sub link_tags($); sub forbidden_file($); sub forbidden_module($); ##### Start of Configuration Area ######## delete $ENV{PATH}; $cvsweb_revision =3D '2.0.6'; use File::Basename (); ($mydir) =3D (File::Basename::dirname($0) =3D~ /(.*)/); # untaint # =3D=3D EDIT this =3D=3D # Locations to search for user configuration, in order: for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsweb.conf') { if (defined($_) && -r $_) { $config =3D $_; last; } } # =3D=3D Configuration defaults =3D=3D # Defaults for configuration variables that shouldn't need # to be configured.. $allow_version_select =3D 1; $allow_log_extra =3D 1; ##### End of Configuration Area ######## ######## Configuration variables ######### # These are defined to allow checking with perl -cw @CVSrepositories =3D @CVSROOT =3D %CVSROOT =3D %MIRRORS =3D = %DEFAULTVALUE =3D %ICONS =3D %MTYPES =3D %tags =3D %alltags =3D @tabcolors =3D %fileinfo =3D (); $cvstreedefault =3D $body_tag =3D $body_tag_for_src =3D $logo =3D = $defaulttitle =3D $address =3D $long_intro =3D $short_instruction =3D $shortLogLen =3D = $show_author =3D $dirtable =3D $tablepadding =3D $columnHeaderColorDefault =3D $columnHeaderColorSorted =3D $hr_breakable =3D $showfunc =3D = $hr_ignwhite =3D $hr_ignkeysubst =3D $diffcolorHeading =3D $diffcolorEmpty =3D = $diffcolorRemove =3D $diffcolorChange =3D $diffcolorAdd =3D $diffcolorDarkChange =3D = $difffontface =3D $difffontsize =3D $inputTextSize =3D $mime_types =3D = $allow_annotate =3D $allow_markup =3D $use_java_script =3D = $open_extern_window =3D $extern_window_width =3D $extern_window_height =3D $edit_option_form = =3D $show_subdir_lastmod =3D $show_log_in_markup =3D $v =3D = $navigationHeaderColor =3D $tableBorderColor =3D $markupLogColor =3D $tabstop =3D $use_moddate = =3D $moddate =3D $gzip_open =3D $HTML_DOCTYPE =3D $HTML_META =3D undef; $tmpdir =3D defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp"; $LOG_FILESEPARATOR =3D q/^=3D{77}$/; $LOG_REVSEPARATOR =3D q/^-{28}$/; @DIFFTYPES =3D qw(h H u c s); @DIFFTYPES{@DIFFTYPES} =3D ( { 'descr' =3D> 'colored', 'opts' =3D> ['-u'], 'colored' =3D> 1, }, { 'descr' =3D> 'long colored', 'opts' =3D> ['--unified=3D15'], 'colored' =3D> 1, }, { 'descr' =3D> 'unified', 'opts' =3D> ['-u'], 'colored' =3D> 0, }, { 'descr' =3D> 'context', 'opts' =3D> ['-c'], 'colored' =3D> 0, }, { 'descr' =3D> 'side by side', 'opts' =3D> ['--side-by-side', '--width=3D164'], 'colored' =3D> 0, }, ); @LOGSORTKEYS =3D qw(cvs date rev); @LOGSORTKEYS{@LOGSORTKEYS} =3D ( { 'descr' =3D> 'Not sorted', }, { 'descr' =3D> 'Commit date', }, { 'descr' =3D> 'Revision', }, ); $HTML_DOCTYPE =3D ''; $HTML_META =3D < EOM ##### End of configuration variables ##### use Time::Local (); use IPC::Open2 qw(open2); # Check if the zlib C library interface is installed, and if yes # we can avoid using the extra gzip process. eval { require Compress::Zlib; }; $has_zlib =3D !$@; $verbose =3D $v; $checkoutMagic =3D "~checkout~"; $pathinfo =3D defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; $where =3D $pathinfo; $doCheckout =3D ($where =3D~ m|^/$checkoutMagic/|); $where =3D~ s|^/$checkoutMagic/|/|; $where =3D~ s|^/||; $scriptname =3D defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; $scriptname =3D~ s|^/*|/|; # Let's workaround thttpd's stupidity.. if ($scriptname =3D~ m|/$|) { $pathinfo .=3D '/'; my $re =3D quotemeta $pathinfo; $scriptname =3D~ s/$re$//; } $scriptwhere =3D $scriptname; $scriptwhere .=3D '/' . urlencode($where); $where =3D '/' if ($where eq ''); $is_mod_perl =3D defined($ENV{MOD_PERL}); # in lynx, it it very annoying to have two links # per file, so disable the link at the icon # in this case: $Browser =3D $ENV{HTTP_USER_AGENT} || ''; $is_links =3D ($Browser =3D~ m`^Links `); $is_lynx =3D ($Browser =3D~ m`^Lynx/`i); $is_w3m =3D ($Browser =3D~ m`^w3m/`i); $is_msie =3D ($Browser =3D~ m`MSIE`); $is_mozilla3 =3D ($Browser =3D~ m`^Mozilla/[3-9]`); $is_textbased =3D ($is_links || $is_lynx || $is_w3m); $nofilelinks =3D $is_textbased; # newer browsers accept gzip content encoding # and state this in a header # (netscape did always but didn't state it) # It has been reported that these # braindamaged MS-Internet Exploders claim that they # accept gzip .. but don't in fact and # display garbage then :-/ # Turn off gzip if running under mod_perl and no zlib is available, # piping does not work as expected inside the server. $maycompress =3D (((defined($ENV{HTTP_ACCEPT_ENCODING}) && $ENV{HTTP_ACCEPT_ENCODING} =3D~ m`gzip`) || $is_mozilla3) && = !$is_msie && !($is_mod_perl && !$has_zlib)); # put here the variables we need in order # to hold our state - they will be added (with # their current value) to any link/query string # you construct @stickyvars =3D qw(cvsroot hideattic sortby logsort f only_with_tag); @unsafevars =3D qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2); if (-f $config) { do "$config" or fatal("500 Internal Error", 'Error in loading configuration file: = %s

%s
', $config, $@); } else { fatal("500 Internal Error", 'Configuration not found. Set the variable = $config in cvsweb.cgi to your cvsweb.conf = configuration file first.' ); } undef %input; $query =3D $ENV{QUERY_STRING}; if (defined($query) && $query ne '') { foreach (split (/&/, $query)) { y/+/ /; s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted if (/(\S+)=3D(.*)/) { $input{$1} =3D $2 if ($2 ne ""); } else { $input{$_}++; } } } # For backwards compability, set only_with_tag to only_on_branch if set. $input{only_with_tag} =3D $input{only_on_branch} if (defined($input{only_on_branch})); # Prevent cross-site scripting foreach (@unsafevars) { # Colons are needed in diffs between tags. if (defined($input{$_}) && $input{$_} =3D~ /[^\w\-.:]/) { fatal("500 Internal Error", 'Malformed query (%s=3D%s)', $_, $input{$_}); } } if (defined($input{"content-type"})) { fatal("500 Internal Error", "Unsupported content-type") if ($input{"content-type"} !~ = /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/); } $DEFAULTVALUE{'cvsroot'} =3D $cvstreedefault; foreach (keys %DEFAULTVALUE) { # replace not given parameters with the default parameters if (!defined($input{$_}) || $input{$_} eq "") { # Empty Checkboxes in forms return -- nothing. So we = define a helper # variable in these forms (copt) which indicates that we = just set # parameters with a checkbox if (!defined($input{"copt"})) { # 'copt' isn't defined --> empty input is not = the result # of empty input checkbox --> set default $input{$_} =3D $DEFAULTVALUE{$_} if (defined($DEFAULTVALUE{$_})); } else { # 'copt' is defined -> the result of empty input = checkbox # -> set to zero (disable) if default is a = boolean (0|1). $input{$_} =3D 0 if (defined($DEFAULTVALUE{$_}) && ($DEFAULTVALUE{$_} eq "0" || $DEFAULTVALUE{$_} eq "1")); } } } $barequery =3D ""; my @barequery; foreach (@stickyvars) { # construct a query string with the sticky non default = parameters set if (defined($input{$_}) && $input{$_} ne '' && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq = $DEFAULTVALUE{$_})) { push @barequery, join ('=3D', urlencode($_), urlencode($input{$_})); } } # is there any query ? if (@barequery) { $barequery =3D join ('&', @barequery); $query =3D "?$barequery"; $barequery =3D "&$barequery"; } else { $query =3D ""; } undef @barequery; if (defined($input{path})) { redirect("$scriptname/$input{path}$query"); } # get actual parameters $sortby =3D $input{"sortby"}; $bydate =3D 0; $byrev =3D 0; $byauthor =3D 0; $bylog =3D 0; $byfile =3D 0; if ($sortby eq "date") { $bydate =3D 1; } elsif ($sortby eq "rev") { $byrev =3D 1; } elsif ($sortby eq "author") { $byauthor =3D 1; } elsif ($sortby eq "log") { $bylog =3D 1; } else { $byfile =3D 1; } $defaultDiffType =3D $input{'f'}; $logsort =3D $input{'logsort'}; { my @tmp =3D @CVSrepositories; my @pair; while (@pair =3D splice(@tmp, 0, 2)) { my ($key, $val) =3D @pair; my ($descr, $cvsroot) =3D @$val; next if !-d $cvsroot; $CVSROOTdescr{$key} =3D $descr; $CVSROOT{$key} =3D $cvsroot; push @CVSROOT, $key; } } ## Default CVS-Tree if (!defined($CVSROOT{$cvstreedefault})) { fatal("500 Internal Error", '$cvstreedefault points to a repository (%s) = not defined in %%CVSROOT (edit your configuration file = %s)', $cvstreedefault, $config); } # alternate CVS-Tree, configured in cvsweb.conf if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) { $cvstree =3D $input{'cvsroot'}; } else { $cvstree =3D $cvstreedefault; } $cvsroot =3D $CVSROOT{$cvstree}; # create icons out of description foreach my $k (keys %ICONS) { no strict 'refs'; my ($itxt, $ipath, $iwidth, $iheight) =3D @{$ICONS{$k}}; if ($ipath) { ${"${k}icon"} =3D sprintf( '3D"%s"', hrefquote($ipath), htmlquote($itxt), $iwidth, = $iheight) } else { ${"${k}icon"} =3D $itxt; } } my $config_cvstree =3D "$config-$cvstree"; # Do some special configuration for cvstrees if (-f $config_cvstree) { do "$config_cvstree" or fatal("500 Internal Error", 'Error in loading configuration file: = %s

%s
', $config_cvstree, $@); } undef $config_cvstree; $re_prcategories =3D '(?:' . join ('|', @prcategories) . ')' if = @prcategories; $re_prkeyword =3D quotemeta($prkeyword) if defined($prkeyword); $prcgi .=3D '%s' if defined($prcgi) && $prcgi !~ /%s/; $fullname =3D "$cvsroot/$where"; $mimetype =3D &getMimeTypeFromSuffix($fullname); $defaultTextPlain =3D ($mimetype eq "text/plain"); $defaultViewable =3D $allow_markup && viewable($mimetype); my $rewrite =3D 0; if ($pathinfo =3D~ m|//|) { $pathinfo =3D~ y|/|/|s; $rewrite =3D 1; } if (-d $fullname && $pathinfo !~ m|/$|) { $pathinfo .=3D '/'; $rewrite =3D 1; } if (!-d $fullname && $pathinfo =3D~ m|/$|) { chop $pathinfo; $rewrite =3D 1; } if ($rewrite) { redirect($scriptname . urlencode($pathinfo) . $query); } undef $rewrite; if (!-d $cvsroot) { 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.'); } # # See if the module is in our forbidden list. # $where =3D~ m:([^/]*):; $module =3D $1; if ($module && &forbidden_module($module)) { fatal("403 Forbidden", 'Access to %s forbidden.', $where); } # # Handle tarball downloads before any headers are output. # if ($input{tarball}) { fatal("403 Forbidden", 'Downloading tarballs is prohibited.') unless $allow_tar; my ($module) =3D ($where =3D~ m,^/?(.*),); # untaint $module =3D~ s,/([^/]*)$,,; my ($ext) =3D ($1 =3D~ /(\.tar\.gz|\.zip)$/); my ($basedir) =3D ($module =3D~ m,([^/]+)$,); if ($basedir eq '' || $module eq '') { fatal("500 Internal Error", 'You cannot download the top level directory.'); } my $tmpexportdir =3D "$tmpdir/.cvsweb.$$." . int(time); mkdir($tmpexportdir, 0700) or fatal("500 Internal Error", 'Unable to make temporary directory: %s', $!); my @fatal; my $tag =3D (exists $input{only_with_tag} && length = $input{only_with_tag}) ? $input{only_with_tag} : "HEAD"; if ($tag eq 'MAIN') { $tag =3D 'HEAD'; } if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', = '-r', $tag, '-d', "$tmpexportdir/$basedir", $module) { @fatal =3D ("500 Internal Error", 'cvs co failure: %s: %s', $!, $module); } else { $| =3D 1; # Essential to get the buffering right. if ($ext eq '.tar.gz') { print "Content-Type: = application/x-gzip\r\n\r\n"; system "$CMD{tar} @tar_options -cf - -C = $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c" and @fatal =3D ("500 Internal Error", 'tar zc failure: %s: %s', $!, $basedir); } elsif ($ext eq '.zip' && $CMD{zip}) { print "Content-Type: application/zip\r\n\r\n"; system "cd $tmpexportdir && $CMD{zip} @zip_options = -r - $basedir" and @fatal =3D ("500 Internal Error", 'zip failure: %s: %s', $!, $basedir); } else { @fatal =3D ("500 Internal Error", 'unsupported file type'); } } system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir; &fatal(@fatal) if @fatal; exit; } ############################## # View a directory ############################### if (-d $fullname) { my $dh =3D do { local (*DH); }; opendir($dh, $fullname) or fatal("404 Not Found", '%s: %s', $where, $!); my @dir =3D readdir($dh); closedir($dh); my @subLevelFiles =3D findLastModifiedSubdirs(@dir) if ($show_subdir_lastmod); getDirLogs($cvsroot, $where, @subLevelFiles); if ($where eq '/') { html_header($defaulttitle); $long_intro =3D~ = s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; print $long_intro; } else { html_header($where); print $short_instruction; } if ($use_descriptions && open(DESC, = "<$cvsroot/CVSROOT/descriptions")) { while () { chomp; my ($dir, $description) =3D /(\S+)\s+(.*)/; $descriptions{$dir} =3D $description; } close(DESC); } print "

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

Current directory: ", = &clickablePath($where, 0), "

\n"; print "

Current tag: ", = $input{only_with_tag},"

\n" if $input{only_with_tag}; } print "
\n"; # Using in this manner violates the HTML2.0 spec but # provides the results that I want in most browsers. Another # case of layout spooging up HTML. my $infocols =3D 0; if ($dirtable) { print "\n"; $infocols++; printf "\n\n"; # do not display the other column-headers, if we do not = have any files # with revision information: if (scalar(%fileinfo)) { $infocols++; printf '\n"; $infocols++; printf '\n"; if ($show_author) { $infocols++; printf '\n"; } $infocols++; printf '\n"; } elsif ($use_descriptions) { printf '\n"; $infocols++; } print "\n"; } else { print "\n"; } my $dirrow =3D 0; my $i; lookingforattic: for ($i =3D 0 ; $i <=3D $#dir ; $i++) { if ($dir[$i] eq "Attic") { last lookingforattic; } } if (!$input{'hideattic'} && ($i <=3D $#dir) && opendir($dh, $fullname . "/Attic")) { splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), = readdir($dh))); closedir($dh); } my $hideAtticToggleLink =3D $input{'hideattic'} ? '' : &link('[Hide]', sprintf('./%s#dirlist', = &toggleQuery("hideattic"))); # Sort without the Attic/ pathname. # place directories first my $attic; my $url; my $fileurl; my $filesexists; my $filesfound; foreach my $file (sort { &fileSortCmp } @dir) { next if ($file eq '.'); # ignore CVS lock and stale NFS files next if ($file =3D~ /^#cvs\.|^,|^\.nfs/); # Check whether to show the CVSROOT path next if ($input{'hidecvsroot'} && $file eq 'CVSROOT'); # Check whether the module is in the restricted list next if ($file && &forbidden_module($file)); # Ignore non-readable files next if ($input{'hidenonreadable'} && !(-r = "$fullname/$file")); if ($file =3D~ s|^Attic/||) { $attic =3D " (in the Attic) " . = $hideAtticToggleLink; } else { $attic =3D ""; } if ($file eq '..' || -d "$fullname/$file") { next if ($file eq '..' && $where eq '/'); my ($rev, $date, $log, $author, $filename) =3D @{$fileinfo{$file}} if (defined($fileinfo{$file})); printf "\n\n\n\n\n\n\n\n"; } else { print "
\n"; } $dirrow++; } elsif ($file =3D~ s/,v$//) { # Skip forbidden files now so we'll give no hint # about their existence. This should probably = have # been done earlier, but it's straightforward = here. next if forbidden_file("$fullname/$file"); $fileurl =3D ($attic ? "Attic/" : "") . = urlencode($file); $url =3D './' . $fileurl . $query; $filesexists++; next if (!defined($fileinfo{$file})); my ($rev, $date, $log, $author) =3D = @{$fileinfo{$file}}; $filesfound++; printf "\n\n\n\n\n\n" if ($dirtable); print(($dirtable) ? "" : "
"); $dirrow++; } print "\n"; } print($dirtable ? "
", $byfile ? $columnHeaderColorSorted : $columnHeaderColorDefault; if ($byfile) { print 'File'; } else { print &link( 'File', sprintf( './%s#dirlist', &toggleQuery("sortby", "file") ) ); } print "', $byrev ? $columnHeaderColorSorted : $columnHeaderColorDefault; if ($byrev) { print 'Rev.'; } else { print &link( 'Rev.', sprintf( './%s#dirlist', &toggleQuery("sortby", = "rev") ) ); } print "', $bydate ? $columnHeaderColorSorted : $columnHeaderColorDefault; if ($bydate) { print 'Age'; } else { print &link( 'Age', sprintf( './%s#dirlist', &toggleQuery("sortby", = "date") ) ); } print "', $byauthor ? $columnHeaderColorSorted = : $columnHeaderColorDefault; if ($byauthor) { print 'Author'; } else { print &link( 'Author', sprintf( './%s#dirlist', &toggleQuery( = "sortby", "author" ) ) ); } print "', $bylog ? $columnHeaderColorSorted : $columnHeaderColorDefault; if ($bylog) { print 'Last log entry'; } else { print &link( 'Last log entry', sprintf( './%s#dirlist', &toggleQuery("sortby", = "log") ) ); } print "', $columnHeaderColorDefault; print "Description
", $tabcolors[$dirrow % 2] if $dirtable; if ($file eq '..') { $url =3D "../$query"; if ($nofilelinks) { print $backicon; } else { print &link($backicon, $url); } print ' ', &link("Parent = Directory", $url); } else { $url =3D './' . urlencode($file) . = "/$query"; print ""; if ($nofilelinks) { print $diricon; } else { print &link($diricon, $url); } print ' ', &link("$file/", $url), = $attic; if ($file eq "Attic") { print "  "; print &link( "[Don't hide]", sprintf( './%s#dirlist', &toggleQuery( = "hideattic") ) ); } } # Show last change in dir if ($filename) { print = "  " if ($dirtable); if ($date) { print " ", readableTime(time() - $date, = 0), ""; } if ($show_author) { print " " if = ($dirtable); print $author; } print " " if = ($dirtable); $filename =3D~ s%^[^/]+/%%; print "$filename/$rev"; print "
" if ($dirtable); if ($log) { print " ", &htmlify( substr($log, 0, = $shortLogLen), $allow_dir_extra); if (length $log > 80) { print "..."; } print ""; } } else { my ($dwhere) =3D ($where ne "/" ? $where : "") . = $file; if ($use_descriptions && defined $descriptions{$dwhere}) { print "		 " if $dirtable; print $descriptions{$dwhere}; } elsif ($dirtable && $infocols > 1) { # close the row with the = appropriate number of # columns, so that the vertical = seperators are visible my ($cols) =3D $infocols; while ($cols > 1) { print = " "; $cols--; } } } if ($dirtable) { print "
", $tabcolors[$dirrow % 2] if $dirtable; print ""; if ($nofilelinks) { print $fileicon; } else { print &link($fileicon, $url); } print ' ', &link(htmlquote($file), $url), = $attic; print " " if ($dirtable); download_link($fileurl, $rev, $rev, $defaultViewable ? = "text/x-cvsweb-markup" : undef); print " " if ($dirtable); if ($date) { print " ", readableTime(time() - = $date, 0), ""; } if ($show_author) { print " " if = ($dirtable); print $author; } print " " if ($dirtable); if ($log) { print " ", &htmlify(substr($log, 0, = $shortLogLen), $allow_dir_extra); if (length $log > 80) { print "..."; } print ""; } print "
\n" : "\n"); if ($filesexists && !$filesfound) { print "

NOTE: There are $filesexists files, but = none matches the current tag ($input{only_with_tag}).

\n"; } if ($input{only_with_tag} && (!%tags || = !$tags{$input{only_with_tag}})) { %tags =3D %alltags } if (scalar %tags || $input{only_with_tag} || $edit_option_form || defined($input{"options"})) { print "
\n"; } if (scalar %tags || $input{only_with_tag}) { print "
\n"; foreach my $var (@stickyvars) { print "\n" if (defined($input{$var}) && (!defined($DEFAULTVALUE{$var}) || $input{$var} ne $DEFAULTVALUE{$var}) && $input{$var} ne "" && $var ne = "only_with_tag"); } print "

\n"; print "\n"; print " \n"; printf "\n", htmlquote($where); print "

\n"; print "
\n"; } if ($allow_tar) { my ($basefile) =3D ($where =3D~ m,(?:.*/)?([^/]+),); if (defined($basefile) && $basefile ne '') { print "
\n", "
Download this = directory in "; # Mangle the filename so browsers show a = reasonable # filename to download. print &link("tarball", = "./$basefile.tar.gz$query" . ($query ? "&" : "?") . "tarball=3D1"); if ($CMD{zip}) { print " or ", &link("zip archive", = "./$basefile.zip$query" . ($query ? "&" : "?") . = "tarball=3D1"); } print "
\n"; } } if ($edit_option_form || defined($input{"options"})) { my $formwhere =3D $scriptwhere; $formwhere =3D~ s|Attic/?$|| if ($input{'hideattic'}); print "
\n"; print "\n"; if ($cvstree ne $cvstreedefault) { print "\n"; } print "
\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n\n\n
Preferences
"; print "\n"; printLogSortSelect(0); print "
"; printDiffSelect(0); print ""; print "
"; print ""; print "
\n
\n
\n"; } html_footer(); } ############################### # View Files ############################### elsif (-f $fullname . ',v') { if (forbidden_file($fullname)) { fatal('403 Forbidden', 'Access forbidden. This file is mentioned in = @ForbiddenFiles'); return; } if (defined($input{'rev'}) || $doCheckout) { &doCheckout($fullname, $input{'rev'}); gzipclose(); exit; } if (defined($input{'annotate'}) && $allow_annotate) { &doAnnotate($input{'annotate'}); gzipclose(); exit; } if (defined($input{'r1'}) && defined($input{'r2'})) { &doDiff( $fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, $input{'tr2'}, $input{'f'} ); gzipclose(); exit; } print("going to dolog($fullname)\n") if ($verbose); &doLog($fullname); ############################## # View Diff ############################## } elsif ($fullname =3D~ s/\.diff$// && -f $fullname . ",v" && = $input{'r1'} && $input{'r2'}) { # $where-diff-removal if 'cvs rdiff' is used # .. but 'cvs rdiff'doesn't support some options # rcsdiff does (-w and -p), so it is disabled # $where =3D~ s/\.diff$//; # Allow diffs using the ".diff" extension # so that browsers that default to the URL # for a save filename don't save diff's as # e.g. foo.c &doDiff( $fullname, $input{'r1'}, $input{'tr1'}, = $input{'r2'}, $input{'tr2'}, $input{'f'} ); gzipclose(); exit; } elsif (($newname =3D $fullname) =3D~ s|/([^/]+)$|/Attic/$1| && -f = $newname . ",v") { # The file has been removed and is in the Attic. # Send a redirect pointing to the file in the Attic. (my $newplace =3D $scriptwhere) =3D~ s|/([^/]+)$|/Attic/$1|; if ($ENV{QUERY_STRING} ne "") { redirect("${newplace}?$ENV{QUERY_STRING}"); } else { redirect($newplace); } exit; } elsif (0 && (my @files =3D &safeglob($fullname . ",v"))) { http_header("text/plain"); print "You matched the following files:\n"; print join ("\n", @files); # Find the tags from each file # Display a form offering diffs between said tags } else { my $fh =3D do { local (*FH); }; my ($xtra, $module); # Assume it's a module name with a potential path following it. $xtra =3D (($module =3D $where) =3D~ s|/.*||) ? $& : ''; # Is there an indexed version of modules? if (open($fh, "< $cvsroot/CVSROOT/modules")) { while (<$fh>) { if (/^(\S+)\s+(\S+)/o && $module eq $1 && -d "$cvsroot/$2" && $module ne $2) { redirect("$scriptname/$2$xtra$query"); } } } fatal("404 Not Found", '%s: no such file or directory', $where); } gzipclose(); ## End MAIN sub printDiffSelect($) { my ($use_java_script) =3D @_; my $f =3D $input{'f'}; print '"; } sub printLogSortSelect($) { my ($use_java_script) =3D @_; print '"; } sub findLastModifiedSubdirs(@) { my (@dirs) =3D @_; my ($dirname, @files); foreach $dirname (@dirs) { next if ($dirname eq "."); next if ($dirname eq ".."); my ($dir) =3D "$fullname/$dirname"; next if (!-d $dir); my ($lastmod) =3D undef; my ($lastmodtime) =3D undef; my $dh =3D do { local (*DH); }; opendir($dh, $dir) or next; my (@filenames) =3D readdir($dh); closedir($dh); foreach my $filename (@filenames) { $filename =3D "$dirname/$filename"; my ($file) =3D "$fullname/$filename"; next if ($filename !~ /,v$/ || !-f $file); # Skip forbidden files. (my $f =3D $file) =3D~ s/,v$//; next if forbidden_file($f); $filename =3D~ s/,v$//; my $modtime =3D -M $file; if (!defined($lastmod) || $modtime < = $lastmodtime) { $lastmod =3D $filename; $lastmodtime =3D $modtime; } } push (@files, $lastmod) if (defined($lastmod)); } return @files; } sub htmlify_sub(&$) { (my $proc, local $_) =3D @_; my @a =3D split (m`(]+>[^<]*)`i); my $linked; my $result =3D ''; while (($_, $linked) =3D splice(@a, 0, 2)) { &$proc(); $result .=3D $_ if defined($_); $result .=3D $linked if defined($linked); } $result; } sub htmlify($;$) { (local $_, my $extra) =3D @_; $_ =3D htmlquote($_); # get URL's as link s{ (http|ftp|https)://\S+ }{ &link($&, htmlunquote($&)) }egx; # get e-mails as link $_ =3D htmlify_sub { s< [\w+=3D\-.!]+@[\w\-]+(\.[\w\-]+)+ >< &link($&, "mailto:$&") >egix; } $_; if ($extra) { # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR = nnnn, ..." "bin/nnnn" if (defined($prcgi) && defined($re_prkeyword)) { my $prev; do { $prev =3D $_; $_ =3D htmlify_sub { s{ (\b$re_prkeyword[:\#]?\s* (?: \#? \d+[,\s]\s* )* \#?) (\d+)\b }{ $1 . &link($2, sprintf($prcgi, $2)) }egix; } $_; } while ($_ ne $prev); if (defined($re_prcategories)) { $_ =3D htmlify_sub { s{ (\b$re_prcategories/(\d+)\b) }{ &link($1, sprintf($prcgi, $2)) }egox; } $_; } } # get manpage specs as link: "foo.1" "foo(1)" if (defined($mancgi)) { $_ =3D htmlify_sub { s{ (\b([a-zA-Z][\w.]+) (?: \( ([0-9n]) \)\B | \.([0-9n])\b ) ) }{ &link($1, sprintf($mancgi, defined($3) ? $3 : $4, = $2)) }egx; } $_; } } $_; } sub spacedHtmlText($;$) { local $_ =3D $_[0]; my $ts =3D $_[1] || $tabstop; # Cut trailing spaces and tabs s/[ \t]+$//; if (defined($ts)) { # Expand tabs 1 while s/\t+/' ' x (length($&) * $ts - length($`) % = $ts)/e } # replace and (\001 is to protect us from htmlify) # gzip can make excellent use of this repeating pattern :-) if ($hr_breakable) { # make every other space 'breakable' s/ / \001nbsp;/g; # 2 * # leave single space as it is } else { s/ /\001nbsp;/g; } $_ =3D htmlify($_, $allow_source_extra); # unescape y/\001/&/; return $_; } # Note that this doesn't htmlquote the first argument... sub link($$) { my ($name, $url) =3D @_; $url =3D~ s/:/sprintf("%%%02x", ord($&))/eg if $url =3D~ /^[^a-z]/; # relative sprintf '%s', hrefquote($url), $name; } sub revcmp($$) { my ($rev1, $rev2) =3D @_; # make no comparison for a tag or a branch return 0 if $rev1 =3D~ /[^\d.]/ || $rev2 =3D~ /[^\d.]/; my (@r1) =3D split (/\./, $rev1); my (@r2) =3D split (/\./, $rev2); my ($a, $b); while (($a =3D shift (@r1)) && ($b =3D shift (@r2))) { if ($a !=3D $b) { return $a <=3D> $b; } } if (@r1) { return 1; } if (@r2) { return -1; } return 0; } sub fatal($$@) { my ($errcode, $format, @args) =3D @_; if ($is_mod_perl) { Apache->request->status((split (/ /, $errcode))[0]); } else { print "Status: $errcode\r\n"; } html_header("Error"); print "

Error: ", sprintf($format, map(htmlquote($_), @args)), "

\n"; html_footer(); exit(1); } sub redirect($) { my ($url) =3D @_; if ($is_mod_perl) { Apache->request->status(301); Apache->request->header_out(Location =3D> $url); } else { print "Status: 301 Moved\r\n"; print "Location: $url\r\n"; } html_header("Moved"); print "

This document is located ", &link('here', $url), = "

\n"; html_footer(); exit(1); } sub safeglob($) { my ($filename) =3D @_; my ($dirname); my (@results); my $dh =3D do { local (*DH); }; ($dirname =3D $filename) =3D~ s|/[^/]+$||; $filename =3D~ s|.*/||; if (opendir($dh, $dirname)) { my $glob =3D $filename; my $t; # transform filename from glob to regex. Deal = with: # [, {, ?, * as glob chars # make sure to escape all other regex chars $glob =3D~ s/([\.\(\)\|\+])/\\$1/g; $glob =3D~ s/\*/.*/g; $glob =3D~ s/\?/./g; $glob =3D~ s/{([^}]+)}/($t =3D $1) =3D~ s-,-|-g; = "($t)"/eg; foreach (readdir($dh)) { if (/^${glob}$/) { push (@results, "$dirname/" . $_); } } closedir($dh); } @results; } sub search_path($) { my ($command) =3D @_; my $d; for $d (split (/:/, $command_path)) { return "$d/$command" if -x "$d/$command"; } ''; } sub getMimeTypeFromSuffix($) { my ($fullname) =3D @_; my ($mimetype, $suffix); my $fh =3D do { local (*FH); }; ($suffix =3D $fullname) =3D~ s/^.*\.([^.]*)$/$1/; $mimetype =3D $MTYPES{$suffix}; $mimetype =3D $MTYPES{'*'} if (!$mimetype); if (!$mimetype && -f $mime_types) { # okey, this is something special - search the # mime.types database open($fh, "<$mime_types"); while (<$fh>) { if ($_ =3D~ /^\s*(\S+\/\S+).*\b$suffix\b/) { $mimetype =3D $1; last; } } close($fh); } # okey, didn't find anything useful .. if (!($mimetype =3D~ /\S\/\S/)) { $mimetype =3D "text/plain"; } return $mimetype; } ############################### # read first lines like head(1) ############################### sub head($;$) { my $fh =3D $_[0]; my $linecount =3D $_[1] || 10; my @buf; if ($linecount > 0) { my $i; for ($i =3D 0 ; !eof($fh) && $i < $linecount ; $i++) { push @buf, scalar <$fh>; } } else { @buf =3D <$fh>; } @buf; } ############################### # scan vim and Emacs directives ############################### sub scan_directives(@) { my $ts =3D undef; for (@_) { $ts =3D $1 if = /\b(?:ts|tabstop|tab-width)[:=3D]\s*([1-9]\d*)\b/; } ('tabstop' =3D> $ts); } sub openOutputFilter() { return if !defined($output_filter) || $output_filter eq ''; open(STDOUT, "|-") and return; # child of child open(STDERR, '>/dev/null'); exec($output_filter) or exit -1; } ############################### # show Annotation ############################### sub doAnnotate($$) { my ($rev) =3D @_; my ($pid); my ($pathname, $filename); my $reader =3D do { local (*FH); }; my $writer =3D do { local (*FH); }; # make sure the revisions are wellformed, for security # reasons .. if ($rev =3D~ /[^\w.]/) { fatal("404 Not Found", 'Malformed query "%s"', $ENV{QUERY_STRING}); } ($pathname =3D $where) =3D~ s/(Attic\/)?[^\/]*$//; ($filename =3D $where) =3D~ s/^.*\///; # this seems to be necessary $| =3D 1; $| =3D 0; # Flush # Work around a mod_perl bug (?) in order to make open2() work. # Search for "untie STDIN" in mod_perl mailing list archives. my $old_stdin; if ($is_mod_perl && ($old_stdin =3D tied *STDIN)) { local $^W =3D undef; untie *STDIN; } # this annotate version is based on the # cvs annotate-demo Perl script by Cyclic Software # It was written by Cyclic Software, http://www.cyclic.com/, and = is in # the public domain. # we could abandon the use of rlog, rcsdiff and co using # the cvsserver in a similiar way one day (..after rewrite) $pid =3D open2($reader, $writer, $CMD{cvs}, @annotate_options, = 'server') or fatal("500 Internal Error", 'Fatal Error - unable to open cvs for annotation'); # Re-tie STDIN if we fiddled around with it earlier, just to be = sure. tie(*STDIN, ref($old_stdin), $old_stdin) if ($old_stdin && = !tied(*STDIN)); # OK, first send the request to the server. A simplified = example is: # Root /home/kingdon/zwork/cvsroot # Argument foo/xx # Directory foo # /home/kingdon/zwork/cvsroot/foo # Directory . # /home/kingdon/zwork/cvsroot # annotate # although as you can see there are a few more details. print $writer "Root $cvsroot\n"; print $writer "Valid-responses ok error Valid-requests Checked-in Updated = Merged Removed M E\n"; # Don't worry about sending valid-requests, the server just = needs to # support "annotate" and if it doesn't, there isn't anything to = be done. print $writer "UseUnchanged\n"; print $writer "Argument -r\n"; print $writer "Argument $rev\n"; print $writer "Argument $where\n"; # The protocol requires us to fully fake a working directory (at # least to the point of including the directories down to the = one # containing the file in question). # So if $where is "dir/sdir/file", then @dirs will be = ("dir","sdir","file") my @dirs =3D split ('/', $where); my $path =3D ""; foreach (@dirs) { if ($path eq "") { # In our example, $_ is "dir". $path =3D $_; } else { print $writer "Directory $path\n"; print $writer "$cvsroot/$path\n"; # In our example, $_ is "sdir" and $path becomes = "dir/sdir" # And the next time, "file" and "dir/sdir/file" = (which then gets # ignored, because we don't need to send = Directory for the file). $path .=3D "/$_"; } } # And the last "Directory" before "annotate" is the top level. print $writer "Directory .\n"; print $writer "$cvsroot\n"; print $writer "annotate\n"; # OK, we've sent our command to the server. Thing to do is to # close the writer side and get all the responses. If "cvs = server" # were nicer about buffering, then we could just leave it open, = I think. close($writer) or die "cannot close: $!"; http_header(); navigateHeader($scriptwhere, $pathname, $filename, $rev, = "annotate"); print "

Annotation of = $pathname$filename, Revision $rev

\n"; # Ready to get the responses from the server. # For example: # E Annotations for foo/xx # E *************** # M 1.3 (kingdon 06-Sep-97): hello # ok my ($lineNr) =3D 0; my ($oldLrev, $oldLusr) =3D ("", ""); my ($revprint, $usrprint); if ($annTable) { print "\n"; } else { print "
";
        }

        # prefetch several lines
        my @buf =3D head($reader);

        my %d =3D scan_directives(@buf);

        while (@buf || !eof($reader)) {
                $_ =3D @buf ? shift @buf : <$reader>;

                my @words =3D split;

                # Adding one is for the (single) space which follows =
$words[0].
                my $rest =3D substr($_, length($words[0]) + 1);
                if ($words[0] eq "E") {
                        next;
                } elsif ($words[0] eq "M") {
                        $lineNr++;
                        (my $lrev =3D substr($_, 2,  13)) =3D~ y/ //d;
                        (my $lusr =3D substr($_, 16, 9))  =3D~ y/ //d;
                        my $line =3D substr($_, 36);
                        my $isCurrentRev =3D ($rev eq $lrev);

                        # we should parse the date here ..
                        if ($lrev eq $oldLrev) {
                                $revprint =3D sprintf('%-8s', '');
                        } else {
                                $revprint =3D sprintf('%-8s', $lrev);
                                $revprint =3D~
                                    s`\S+`&link($&, =
"$scriptwhere$query#rev$&")`e
                                    ;    # `
                                $oldLusr =3D '';
                        }

                        if ($lusr eq $oldLusr) {
                                $usrprint =3D '';
                        } else {
                                $usrprint =3D $lusr;
                        }
                        $oldLrev =3D $lrev;
                        $oldLusr =3D $lusr;

                        # Set bold for text-based browsers only - =
graphical
                        # browsers show bold fonts a bit wider than =
regular fonts,
                        # so it looks irregular.
                        print "" if ($isCurrentRev && $is_textbased);

                        printf "%s%s %-8s %4d:", $revprint,
                            $isCurrentRev ? '!' : ' ', $usrprint, =
$lineNr;
                        print spacedHtmlText($line, $d{'tabstop'});

                        print "" if ($isCurrentRev && =
$is_textbased);
                } elsif ($words[0] eq "ok") {

                        # We could complain about any text received =
after this, like the
                        # CVS command line client.  But for simplicity, =
we don't.
                } elsif ($words[0] eq "error") {
                        fatal("500 Internal Error",
                              'Error occured during annotate: =
%s',
                              $_);
                }
        }

        if ($annTable) {
                print "
"; } else { print ""; } html_footer(); close($reader) or warn "cannot close: $!"; wait; } ############################### # make Checkout ############################### sub doCheckout($$) { my ($fullname, $rev) =3D @_; my ($mimetype, $revopt); my $fh =3D do { local (*FH); }; if ($rev eq 'HEAD' || $rev eq '.') { $rev =3D undef; } # make sure the revisions a wellformed, for security # reasons .. if (defined($rev) && $rev =3D~ /[^\w.]/) { fatal("404 Not Found", 'Malformed query "%s"', $ENV{QUERY_STRING}); } # get mimetype if (defined($input{"content-type"}) && ($input{"content-type"} =3D~ /\S\/\S/)) { $mimetype =3D $input{"content-type"} } else { $mimetype =3D &getMimeTypeFromSuffix($fullname); } if (defined($rev)) { $revopt =3D "-r$rev"; if ($use_moddate) { readLog($fullname, $rev); $moddate =3D $date{$rev}; } } else { $revopt =3D "-rHEAD"; if ($use_moddate) { readLog($fullname); $moddate =3D $date{$symrev{HEAD}}; } } ### just for the record: ### 'cvs co' seems to have a bug regarding single checkout of ### directories/files having spaces in it; ### this is an issue that should be resolved on cvs's side # # Safely for a child process to read from. if (!open($fh, "-|")) { # child # chdir to $tmpdir before to avoid non-readable cgi-bin = directories chdir($tmpdir); open(STDERR, ">&STDOUT"); # Redirect stderr to stdout # work around a bug of cvs -p; expand symlinks use Cwd 'abs_path'; exec($CMD{cvs}, @cvs_options, '-d', abs_path($cvsroot), 'co', '-p', $revopt, $where) or exit -1; } if (eof($fh)) { fatal("404 Not Found", '%s is not (any longer) pertinent', $where); } = #=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D #Checking out squid/src/ftp.c #RCS: /usr/src/CVS/squid/src/ftp.c,v #VERS: 1.1.1.28.6.2 #*************** # Parse CVS header my ($revision, $filename, $cvsheader); $filename =3D ""; while (<$fh>) { last if (/^\*\*\*\*/); $revision =3D $1 if (/^VERS: (.*)$/); if (/^Checking out (.*)$/) { $filename =3D $1; $filename =3D~ s/^\.\/*//; } $cvsheader .=3D $_; } if ($filename ne $where) { fatal("500 Internal Error", 'Unexpected output from cvs co: %s', $cvsheader); } $| =3D 1; if ($mimetype eq "text/x-cvsweb-markup") { &cvswebMarkup($fh, $fullname, $revision); } else { http_header($mimetype); print <$fh>; } close($fh); } sub cvswebMarkup($$$) { my ($filehandle, $fullname, $revision) =3D @_; my ($pathname, $filename); ($pathname =3D $where) =3D~ s/(Attic\/)?[^\/]*$//; ($filename =3D $where) =3D~ s/^.*\///; my ($fileurl) =3D urlencode($filename); http_header(); navigateHeader($scriptwhere, $pathname, $filename, $revision, = "view"); print "
"; print "\n\n\n\n
"; print "File: ", &clickablePath($where, 1); print " ("; &download_link($fileurl, $revision, "download"); print ")"; if (!$defaultTextPlain) { print " ("; &download_link($fileurl, $revision, "as text", = "text/plain"); print ")"; } print "
\n"; if ($show_log_in_markup) { readLog($fullname); #,$revision); printLog($revision, 0); } else { print "Version: $revision
\n"; print "Tag: ", $input{only_with_tag}, "
\n" if $input{only_with_tag}; } print "
"; my $url =3D download_url($fileurl, $revision, $mimetype); print "
"; if ($mimetype =3D~ /^image/) { printf '3D""
', = hrefquote("$url$barequery"); } elsif ($mimetype =3D~ m%^application/pdf%) { printf '
', hrefquote("$url$barequery"); } elsif ($preformat_in_markup) { print "
";

                # prefetch several lines
                my @buf =3D head($filehandle);

                my %d =3D scan_directives(@buf);

                while (@buf || !eof($filehandle)) {
                        $_ =3D @buf ? shift @buf : <$filehandle>;

                        print spacedHtmlText($_, $d{'tabstop'});
                }
                print "
"; } else { print "
";

                while (<$filehandle>) {
                        print htmlquote($_);
                }
                print "
"; } } sub viewable($) { my ($mimetype) =3D @_; $mimetype =3D~ m%^((text|image)/|application/pdf)%; } ############################### # Show Colored Diff ############################### sub doDiff($$$$$$) { my ($fullname, $r1, $tr1, $r2, $tr2, $f) =3D @_; my $fh =3D do { local (*FH); }; my ($rev1, $rev2, $sym1, $sym2, $f1, $f2); if (&forbidden_file($fullname)) { fatal("403 Forbidden", 'Access forbidden. This file is mentioned in = @ForbiddenFiles'); return; } if ($r1 =3D~ /([^:]+)(:(.+))?/) { $rev1 =3D $1; $sym1 =3D $3; } if ($r1 eq 'text') { $rev1 =3D $tr1; $sym1 =3D ""; } if ($r2 =3D~ /([^:]+)(:(.+))?/) { $rev2 =3D $1; $sym2 =3D $3; } if ($r2 eq 'text') { $rev2 =3D $tr2; $sym2 =3D ""; } # make sure the revisions a wellformed, for security # reasons .. if ($rev1 =3D~ /[^\w.]/ || $rev2 =3D~ /[^\w.]/) { fatal("404 Not Found", 'Malformed query "%s"', $ENV{QUERY_STRING}); } # # rev1 and rev2 are now both numeric revisions. # Thus we do a DWIM here and swap them if rev1 is after rev2. # XXX should we warn about the fact that we do this? if (&revcmp($rev1, $rev2) > 0) { my ($tmp1, $tmp2) =3D ($rev1, $sym1); ($rev1, $sym1) =3D ($rev2, $sym2); ($rev2, $sym2) =3D ($tmp1, $tmp2); } my $difftype =3D $DIFFTYPES{$f}; if (!$difftype) { fatal("400 Bad arguments", 'Diff format %s not understood', $f); } my @difftype =3D @{$difftype->{'opts'}}; my $human_readable =3D $difftype->{'colored'}; # apply special options if ($showfunc) { push @difftype, '-p' if $f ne 's'; my ($re1, $re2); while (($re1, $re2) =3D each %funcline_regexp) { if ($fullname =3D~ /$re1/) { push @difftype, '-F', $re2; last; } } } if ($human_readable) { if ($hr_ignwhite) { push @difftype, '-w'; } if ($hr_ignkeysubst) { push @difftype, '-kk'; } } if (!open($fh, "-|")) { # child open(STDERR, ">&STDOUT"); # Redirect stderr to stdout openOutputFilter(); exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", = $fullname) or exit -1; } if ($human_readable) { http_header(); &human_readable_diff($fh, $rev2); html_footer(); gzipclose(); exit; } else { http_header("text/plain"); } # = #=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D #RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v #retrieving revision 1.16 #retrieving revision 1.17 #diff -c -r1.16 -r1.17 #*** /home/ncvs/src/sys/netinet/tcp_output.c 1995/11/03 = 22:08:08 1.16 #--- /home/ncvs/src/sys/netinet/tcp_output.c 1995/12/05 = 17:46:35 1.17 # # Ideas: # - nuke the stderr output if it's what we expect it to be # - Add "no differences found" if the diff command supplied no = output. # #*** src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 = 1.16 #--- src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 = 1.17 RELENG_2_1_0 # (bogus example, but...) # if (grep { $_ eq '-u' } @difftype) { $f1 =3D '---'; $f2 =3D '\+\+\+'; } else { $f1 =3D '\*\*\*'; $f2 =3D '---'; } while (<$fh>) { if (m|^$f1 $cvsroot|o) { s|$cvsroot/||o; if ($sym1) { chop; $_ .=3D " $sym1\n"; } } elsif (m|^$f2 $cvsroot|o) { s|$cvsroot/||o; if ($sym2) { chop; $_ .=3D " $sym2\n"; } } print $_; } close($fh); } ############################### # Show Logs .. ############################### sub getDirLogs($$@) { my ($cvsroot, $dirname, @otherFiles) =3D @_; my ($state, $otherFiles, $tag, $file, $date, $branchpoint, = $branch, $log); my ($rev, $revision, $revwanted, $filename, $head, $author); $tag =3D $input{only_with_tag}; my ($DirName) =3D "$cvsroot/$where"; my (@files, @filetags); my $fh =3D do { local (*FH); }; push (@files, &safeglob("$DirName/*,v")); push (@files, &safeglob("$DirName/Attic/*,v")) if (!$input{'hideattic'}); foreach my $file (@otherFiles) { push (@files, "$DirName/$file"); } # just execute rlog if there are any files if ($#files < 0) { return; } if (defined($tag)) { #can't use -r as - is allowed in tagnames, but = misinterpreated by rlog.. if (!open($fh, "-|")) { # child open(STDERR, '>/dev/null'); # rlog may complain; = ignore. openOutputFilter(); exec($CMD{rlog}, @files) or exit -1; } } else { if (!open($fh, "-|")) { # child open(STDERR, '>/dev/null'); # rlog may complain; = ignore. openOutputFilter(); exec($CMD{rlog}, '-r', @files) or exit -1; } } $state =3D "start"; while (<$fh>) { if ($state eq "start") { #Next file. Initialize file variables $rev =3D ''; $revwanted =3D ''; $branch =3D ''; $branchpoint =3D ''; $filename =3D ''; $log =3D ''; $revision =3D ''; %symrev =3D (); @filetags =3D (); #jump to head state $state =3D "head"; } print "$state:$_" if ($verbose); again: if ($state eq "head") { #$rcsfile =3D $1 if (/^RCS file: (.+)$/); #not = used (yet) if (/^Working file: (.+)$/) { $filename =3D $1; } elsif (/^head: (.+)$/) { $head =3D $1; } elsif (/^branch: (.+)$/) { $branch =3D $1 } elsif (/^symbolic names:/) { $state =3D "tags"; ($branch =3D $head) =3D~ s/\.\d+$// if $branch eq ''; $branch =3D~ s/(\d+)$/0.$1/; $symrev{MAIN} =3D $branch; $symrev{HEAD} =3D $branch; $alltags{MAIN} =3D 1; $alltags{HEAD} =3D 1; push (@filetags, "MAIN", "HEAD"); } elsif (/$LOG_REVSEPARATOR/o) { $state =3D "log"; $rev =3D ''; $date =3D ''; $log =3D ''; # Try to reconstruct the relative = filename if RCS spits out a full path $filename =3D~ s%^\Q$DirName\E/%%; } next; } if ($state eq "tags") { if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) { push (@filetags, $1); $symrev{$1} =3D $2; $alltags{$1} =3D 1; next; } elsif (/^\S/) { if (defined($tag)) { if (defined($symrev{$tag}) || $tag eq "HEAD") { $revwanted =3D $symrev{$tag eq = "HEAD" ? "MAIN" : $tag}; ($branch =3D $revwanted) = =3D~ s/\b0\.//; ($branchpoint =3D = $branch) =3D~ s/\.?\d+$//; $revwanted =3D '' if ($revwanted ne = $branch); } elsif ($tag ne "HEAD") { print "Tag not found, skip = this file" if ($verbose); $state =3D "skip"; next; } } foreach my $tagfound (@filetags) { $tags{$tagfound} =3D 1; } $state =3D "head"; goto again; } } if ($state eq "log") { if (/$LOG_REVSEPARATOR/o || = /$LOG_FILESEPARATOR/o) { # End of a log entry. my $revbranch =3D $rev; $revbranch =3D~ s/\.\d+$//; print "$filename $rev Wanted: $revwanted = ", "Revbranch: $revbranch Branch: = $branch ", "Branchpoint: $branchpoint\n" if ($verbose); if ($revwanted eq '' && $branch ne '' && $branch eq $revbranch || = !defined($tag)) { print "File revision $rev found = for branch $branch\n" if ($verbose); $revwanted =3D $rev; } if ($revwanted ne '' ? $rev eq = $revwanted : $branchpoint ne '' ? $rev eq = $branchpoint : 0 && ($rev eq $head)) { # Don't think head is needed here.. print "File info $rev found for = $filename\n" if ($verbose); my @finfo =3D ($rev, $date, $log, $author, $filename); my ($name); ($name =3D $filename) =3D~ = s%/.*%%; $fileinfo{$name} =3D [@finfo]; $state =3D "done" if ($rev eq = $revwanted); } $rev =3D ''; $date =3D ''; $log =3D ''; } elsif ($date eq '' && = m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);| ) { my $yr =3D $1; # damn 2-digit year routines :-) if ($yr > 100) { $yr -=3D 1900; } $date =3D &Time::Local::timegm($6, $5, $4, $3, = $2 - 1, $yr); ($author) =3D /author: ([^;]+)/; $state =3D "log"; $log =3D ''; next; } elsif ($rev eq '' && /^revision = (\d+(?:\.\d+)+).*$/) { $rev =3D $1; # .*$ eats up the = locker(lockers?) info, if any next; } else { $log .=3D $_; } } if (/$LOG_FILESEPARATOR/o) { $state =3D "start"; next; } } if ($. =3D=3D 0) { fatal("500 Internal Error", 'Failed to spawn GNU rlog on "%s". =

Did you set the $command_path in your configuration file = correctly ? (Currently "%s"', join (", ", @files), $command_path); } close($fh); } sub readLog($;$) { my ($fullname, $revision) =3D @_; my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev); my $fh =3D do { local (*FH); }; if (defined($revision)) { $revision =3D "-r$revision"; } else { $revision =3D ""; } undef %symrev; undef %revsym; undef @allrevisions; undef %date; undef %author; undef %state; undef %difflines; undef %log; print("Going to rlog '$fullname'\n") if ($verbose); if (!open($fh, "-|")) { # child if ($revision ne '') { openOutputFilter(); exec($CMD{rlog}, $revision, $fullname) or exit = -1; } else { openOutputFilter(); exec($CMD{rlog}, $fullname) or exit -1; } } while (<$fh>) { print if ($verbose); if ($symnames) { if (/^\s+([^:]+):\s+([\d\.]+)/) { $symrev{$1} =3D $2; } else { $symnames =3D 0; } } elsif (/^head:\s+([\d\.]+)/) { $head =3D $1; } elsif (/^branch:\s+([\d\.]+)/) { $curbranch =3D $1; } elsif (/^symbolic names/) { $symnames =3D 1; } elsif (/^-----/) { last; } } ($curbranch =3D $head) =3D~ s/\.\d+$// if = (!defined($curbranch)); # each log entry is of the form: # ---------------------------- # revision 3.7.1.1 # date: 1995/11/29 22:15:52; author: fenner; state: Exp; = lines: +5 -3 # log info # ---------------------------- # For a locked revision, the first line after the separator=20 # becomes smth like # revision 9.19 locked by: vassilii; logentry: while (!/$LOG_FILESEPARATOR/o) { $_ =3D <$fh>; last logentry if (!defined($_)); # EOF print "R:", $_ if ($verbose); if (/^revision (\d+(?:\.\d+)+)/) { $rev =3D $1; unshift (@allrevisions, $rev); } elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) = { next logentry; } else { # The rlog output is syntactically ambiguous. = We must # have guessed wrong about where the end of the = last log # message was. # Since this is likely to happen when people put = rlog output # in their commit messages, don't even bother = keeping # these lines since we don't know what revision = they go with # any more. next logentry; } $_ =3D <$fh>; print "D:", $_ if ($verbose); if ( = m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);\s+st= ate:\s+(\S+);\s+(lines:\s+([0-9\s+-]+))?| ) { my $yr =3D $1; # damn 2-digit year routines :-) if ($yr > 100) { $yr -=3D 1900; } $date{$rev} =3D &Time::Local::timegm($6, $5, $4, $3, $2 - 1, = $yr); $author{$rev} =3D $7; $state{$rev} =3D $8; $difflines{$rev} =3D $10; } else { fatal("500 Internal Error", 'Error parsing RCS output: %s', $_); } line: while (<$fh>) { print "L:", $_ if ($verbose); next line if (/^branches:\s/); last line if (/$LOG_FILESEPARATOR/o || = /$LOG_REVSEPARATOR/o); $log{$rev} .=3D $_; } print "E:", $_ if ($verbose); } close($fh); print "Done reading RCS file\n" if ($verbose); @revorder =3D reverse sort { revcmp($a, $b) } @allrevisions; print "Done sorting revisions", join (" ", @revorder), "\n" if ($verbose); # # HEAD is an artificial tag which is simply the highest tag = number on the main # branch, unless there is a branch tag in the RCS file in which = case it's the # highest revision on that branch. Find it by looking through = @revorder; it # is the first commit listed on the appropriate branch. # This is not neccesary the same revision as marked as head in = the RCS file. my $headrev =3D $curbranch || "1"; ($symrev{"MAIN"} =3D $headrev) =3D~ s/(\d+)$/0.$1/; foreach $rev (@revorder) { if ($rev =3D~ /^(\S*)\.\d+$/ && $headrev eq $1) { $symrev{"HEAD"} =3D $rev; last; } } ($symrev{"HEAD"} =3D $headrev) =3D~ s/\.\d+$// if (!defined($symrev{"HEAD"})); print "Done finding HEAD\n" if ($verbose); # # Now that we know all of the revision numbers, we can associate # absolute revision numbers with all of the symbolic names, and # pass them to the form so that the same association doesn't = have # to be built then. # undef @branchnames; undef %branchpoint; undef $sel; foreach (reverse sort keys %symrev) { $rev =3D $symrev{$_}; if ($rev =3D~ /^((.*)\.)?\b0\.(\d+)$/) { push (@branchnames, $_); # # A revision number of A.B.0.D really translates = into # "the highest current revision on branch = A.B.D". # # If there is no branch A.B.D, then it = translates into # the head A.B . # # This reasoning also applies to the main branch = A.B, # with the branch number 0.A, with the exception = that # it has no head to translate to if there is = nothing on # the branch, but I guess this can never happen? # # (the code below gracefully forgets about the = branch # if it should happen) # $head =3D defined($2) ? $2 : ""; $branch =3D $3; $branchrev =3D $head . ($head ne "" ? "." : "") = . $branch; my $regex; $regex =3D quotemeta $branchrev; $rev =3D $head; foreach my $r (@revorder) { if ($r =3D~ /^${regex}\b/) { $rev =3D $branchrev; last; } } next if ($rev eq ""); if ($rev ne $head && $head ne "") { $branchpoint{$head} .=3D ", " if ($branchpoint{$head}); $branchpoint{$head} .=3D $_; } } $revsym{$rev} .=3D ", " if ($revsym{$rev}); $revsym{$rev} .=3D $_; $sel .=3D "\n"; } print "Done associating revisions with branches\n" if = ($verbose); my ($onlyonbranch, $onlybranchpoint); if ($onlyonbranch =3D $input{'only_with_tag'}) { $onlyonbranch =3D $symrev{$onlyonbranch}; if ($onlyonbranch =3D~ s/\b0\.//) { ($onlybranchpoint =3D $onlyonbranch) =3D~ = s/\.\d+$//; } else { $onlybranchpoint =3D $onlyonbranch; } if (!defined($onlyonbranch) || $onlybranchpoint eq "") { fatal("404 Tag not found", 'Tag %s not defined', $input{'only_with_tag'}); } } undef @revisions; foreach (@allrevisions) { ($br =3D $_) =3D~ s/\.\d+$//; ($brp =3D $br) =3D~ s/\.\d+$//; next if ($onlyonbranch && $br ne $onlyonbranch && $_ ne $onlybranchpoint); unshift (@revisions, $_); } if ($logsort eq "date") { # Sort the revisions in commit order an secondary sort = on revision # (secondary sort needed for imported sources, or the = first main # revision gets before the same revision on the 1.1.1 = branch) @revdisplayorder =3D sort { $date{$b} <=3D> $date{$a} || -revcmp($a, $b) = } @revisions; } elsif ($logsort eq "rev") { # Sort the revisions in revision order, highest first @revdisplayorder =3D reverse sort { revcmp($a, $b) } = @revisions; } else { # No sorting. Present in the same order as rlog / cvs = log @revdisplayorder =3D @revisions; } } sub printDiffLinks($$) { my ($text, $url) =3D @_; my @extra; local $_; for ($DIFFTYPES{$defaultDiffType}{'colored'} ? qw(u) : qw(h)) { my $f =3D $_ eq $defaultDiffType ? '' : $_; push @extra, &link(lc $DIFFTYPES{$_}{'descr'}, = "$url&f=3D$f"); } print &link($text, $url), ' (', join (', ', @extra), ')'; } sub printLog($;$) { my ($link, $br, $brp); ($_, $link) =3D @_; ($br =3D $_) =3D~ s/\.\d+$//; ($brp =3D $br) =3D~ s/\.?\d+$//; my ($isDead, $prev); $link =3D 1 if (!defined($link)); $isDead =3D ($state{$_} eq "dead"); print "

\n"; if ($link && !$isDead) { my ($filename); ($filename =3D $where) =3D~ s/^.*\///; my ($fileurl) =3D urlencode($filename); print ""; if (defined($revsym{$_})) { foreach my $sym (split (", ", $revsym{$_})) { print ""; } } if (defined($revsym{$br}) && $revsym{$br} && !defined($nameprinted{$br})) { foreach my $sym (split (", ", $revsym{$br})) { print ""; } $nameprinted{$br} =3D 1; } print "\n Revision "; &download_link($fileurl, $_, $_, $defaultViewable ? "text/x-cvsweb-markup" : = undef); if ($defaultViewable) { print " / ("; &download_link($fileurl, $_, "download", = $mimetype); print ")"; } if (not $defaultTextPlain) { print " / ("; &download_link($fileurl, $_, "as text", = "text/plain"); print ")"; } if (!$defaultViewable) { print " / ("; &download_link($fileurl, $_, "view", "text/x-cvsweb-markup"); print ")"; } if ($allow_annotate) { print " - "; print &link( 'annotate', sprintf( '%s/%s?annotate=3D%s%s', = $scriptname, urlencode($where), $_, $barequery ) ); } # Plus a select link if enabled, and this version isn't = selected if ($allow_version_select) { if ((!defined($input{"r1"}) || $input{"r1"} ne = $_)) { print " - "; print &link( '[select for diffs]', sprintf( '%s?r1=3D%s%s', = $scriptwhere, $_, $barequery ) ); } else { print " - [selected]"; } } } else { print "Revision $_"; } if (/^1\.1\.1\.\d+$/) { print " (vendor branch)"; } if (defined @mytz) { my ($est) =3D $mytz[(localtime($date{$_}))[8]]; print ", ", scalar localtime($date{$_}), " $est = ("; } else { print ", ", scalar gmtime($date{$_}), " UTC ("; } print readableTime(time() - $date{$_}, 1), " ago)"; print " by "; print "", $author{$_}, "\n"; print "
Branch: ", $link ? link_tags($revsym{$br}) : = $revsym{$br}, "\n" if ($revsym{$br}); print "
CVS Tags: ", $link ? link_tags($revsym{$_}) : = $revsym{$_}, "" if ($revsym{$_}); print "
Branch point for: ", $link ? link_tags($branchpoint{$_}) : $branchpoint{$_}, = "\n" if ($branchpoint{$_}); # Find the previous revision my @prevrev =3D split (/\./, $_); do { if (--$prevrev[$#prevrev] <=3D 0) { # If it was X.Y.Z.1, just make it X.Y pop (@prevrev); pop (@prevrev); } $prev =3D join (".", @prevrev); } until (defined($date{$prev}) || $prev eq ""); if ($prev ne "") { if ($difflines{$_}) { print "
Changes since $prev: $difflines{$_} = lines"; } } if ($isDead) { print "
FILE REMOVED\n"; } elsif ($link) { my %diffrev =3D (); $diffrev{$_} =3D 1; $diffrev{""} =3D 1; print '
'; my $diff =3D 'Diff'; # # Offer diff to previous revision if ($prev) { $diffrev{$prev} =3D 1; my $url =3D sprintf('%s.diff?r1=3D%s&r2=3D%s%s', = $scriptwhere, $prev, $_, $barequery); print $diff, " to previous "; $diff =3D ''; printDiffLinks($prev, $url); } # # Plus, if it's on a branch, and it's not a vendor = branch, # offer a diff with the branch point. if ($revsym{$brp} && !/^1\.1\.1\.\d+$/ && !defined($diffrev{$brp})) { my $url =3D sprintf('%s.diff?r1=3D%s&r2=3D%s%s', = $scriptwhere, $brp, $_, $barequery); print $diff, " to branchpoint "; $diff =3D ''; printDiffLinks($brp, $url); } # # Plus, if it's on a branch, and it's not a vendor = branch, # offer to diff with the next revision of the higher = branch. # (e.g. change gets committed and then brought # over to -stable) if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) { my ($i, $nextmain); for ($i =3D 0 ; $i < $#revorder && $revorder[$i] = ne $_ ; $i++) { } my @tmp2 =3D split (/\./, $_); for ($nextmain =3D "" ; $i > 0 ; $i--) { my $next =3D $revorder[$i - 1]; my @tmp1 =3D split (/\./, $next); if (@tmp1 < @tmp2) { $nextmain =3D $next; last; } # Only the highest version on a branch = should have # a diff for the "next main". last if (@tmp1 - 1 <=3D @tmp2 && join (".", @tmp1[0 .. $#tmp1 - = 1]) eq join (".", @tmp2[0 .. $#tmp1 - 1])); } if (!defined($diffrev{$nextmain})) { $diffrev{$nextmain} =3D 1; my $url =3D sprintf('%s.diff?r1=3D%s&r2=3D%s%s', $scriptwhere, $nextmain, $_, $barequery); print $diff, " next main "; $diff =3D ''; printDiffLinks($nextmain, $url); } } # Plus if user has selected only r1, then present a link # to make a diff to that revision if (defined($input{"r1"}) && = !defined($diffrev{$input{"r1"}})) { $diffrev{$input{"r1"}} =3D 1; my $url =3D sprintf('%s.diff?r1=3D%s&r2=3D%s%s', = $scriptwhere, $input{'r1'}, $_, $barequery); print $diff, " to selected "; $diff =3D ''; printDiffLinks($input{'r1'}, $url); } } print "\n

\n
\n";
        print &htmlify($log{$_}, $allow_log_extra);
        print "
\n"; } sub doLog($) { my ($fullname) =3D @_; my ($diffrev, $upwhere, $filename, $backurl); readLog($fullname); html_header("CVS log for $where"); ($upwhere =3D $where) =3D~ s|(Attic/)?[^/]+$||; ($filename =3D $where) =3D~ s|^.*/||; $backurl =3D $scriptname . "/" . urlencode($upwhere) . $query; print "

\n "; print &link($backicon, "$backurl#$filename"), " Up to ", &clickablePath($upwhere, 1), "\n

\n"; print "

\n "; print &link('Request diff between arbitrary revisions', = '#diff'); print "\n

\n
\n"; print "

\n"; if ($curbranch) { print "Default branch: ", ($revsym{$curbranch} || = $curbranch); } else { print "No default branch"; } print "
\n"; if ($input{only_with_tag}) { print "Current tag: $input{only_with_tag}
\n"; } print "

\n"; undef %nameprinted; for (my $i =3D 0 ; $i <=3D $#revdisplayorder ; $i++) { print "
\n"; printLog($revdisplayorder[$i]); } print "
\n

\n"; print "\n"; print "This form allows you to request diff's between any = two\n"; print "revisions of a file. You may select a symbolic = revision\n"; print "name using the selection box or you may type in a = numeric\n"; print "name using the type-in text box.\n"; print "\n

\n"; print "
\n"; foreach (@stickyvars) { printf('', $_, $input{$_}) if (defined($input{$_}) && ((!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne = "")); } print "\n\n"; print "\n"; print "\n\n"; print "\n\n"; print "\n"; print "\n
"; print "\n"; print "\n"; $diffrev =3D $revdisplayorder[$#revdisplayorder]; $diffrev =3D $input{"r1"} if (defined($input{"r1"})); print "
"; print "\n"; print "\n"; $diffrev =3D $revdisplayorder[0]; $diffrev =3D $input{"r2"} if (defined($input{"r2"})); print "
\n"; print "
\n"; print "
\n"; print "
\n"; print "\n"; print "\n\n"; print "\n\n\n"; if (@branchnames) { print "\n\n"; print "\n\n\n"; } foreach (@stickyvars) { next if ($_ eq "f"); next if ($_ eq "only_with_tag"); next if ($_ eq "logsort"); print "\n" if (defined($input{$_}) && (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne = ""); } print "\n\n\n"; print "\n"; print "\n
"; print ""; printDiffSelect($use_java_script); print "
"; print ""; print "\n"; print "
"; print "\n"; print ""; printLogSortSelect($use_java_script); print "
\n"; print "
\n"; html_footer(); } sub flush_diff_rows($$$$) { my $j; my ($leftColRef, $rightColRef, $leftRow, $rightRow) =3D @_; if (!defined($state)) { return; } if ($state eq "PreChangeRemove") { # we just got remove-lines = before for ($j =3D 0 ; $j < $leftRow ; $j++) { print "\n @$leftColRef[$j]\n"; print " \n\n"; } } elsif ($state eq "PreChange") { # state eq "PreChange" # we got removes with subsequent adds for ($j =3D 0 ; $j < $leftRow || $j < $rightRow ; $j++) { # dump out both cols print "\n"; if ($j < $leftRow) { print " @$leftColRef[$j]"; } else { print " "; } print "\n"; if ($j < $rightRow) { print " @$rightColRef[$j]"; } else { print " "; } print "\n\n"; } } } ## # Function to generate Human readable diff-files # human_readable_diff(String revision_to_return_to); ## sub human_readable_diff($) { my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd); my ($fh, $rev) =3D @_; my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, = $sym2); my (@rightCol, @leftCol); ($where_nd =3D $where) =3D~ s/.diff$//; ($filename =3D $where_nd) =3D~ s/^.*\///; ($pathname =3D $where_nd) =3D~ s/(Attic\/)?[^\/]*$//; ($scriptwhere_nd =3D $scriptwhere) =3D~ s/.diff$//; navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, = "diff"); # Read header to pick up read revision and date, if possible while (<$fh>) { ($r1d, $r1r) =3D /\t(.*)\t(.*)$/ if (/^--- /); ($r2d, $r2r) =3D /\t(.*)\t(.*)$/ if (/^\+\+\+ /); last if (/^\+\+\+ /); } if (defined($r1r) && $r1r =3D~ /^(\d+\.)+\d+$/) { $rev1 =3D $r1r; $date1 =3D $r1d; } if (defined($r2r) && $r2r =3D~ /^(\d+\.)+\d+$/) { $rev2 =3D $r2r; $date2 =3D $r2d; } print "

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

\n", # Using style=3D\"border: none\" here breaks NS 4.x badly... "\n", "\n", "\n", "\n"; my $leftRow =3D 0; my $rightRow =3D 0; my ($oldline, $newline, $funname, $diffcode, $rest); # Process diff text # prefetch several lines my @buf =3D head($fh); my %d =3D scan_directives(@buf); while (@buf || !eof($fh)) { $difftxt =3D @buf ? shift @buf : <$fh>; if ($difftxt =3D~ /^@@/) { ($oldline, $newline, $funname) =3D $difftxt =3D~ /@@ = \-([0-9]+).*\+([0-9]+).*@@(.*)/; $funname =3D htmlquote($funname); $funname =3D~ s/\s/ /go; print "\n\n\n"; $state =3D "dump"; $leftRow =3D 0; $rightRow =3D 0; } else { ($diffcode, $rest) =3D $difftxt =3D~ /^([-+ = ])(.*)/; $_ =3D spacedHtmlText($rest, $d{'tabstop'}); ######### # little state machine to parse unified-diff = output (Hen, zeller@think.de) # in order to get some nice 'ediff'-mode output # states: # "dump" - just dump the value # "PreChangeRemove" - we began with '-' .. so = this could be the start of a 'change' area or just remove # "PreChange" - okey, we got several '-' = lines and moved to '+' lines -> this is a change block ########## if ($diffcode eq '+') { if ($state eq "dump") { # 'change' never begins with '+': just = dump out value print "\n\n\n\n"; } else { # we got minus before $state =3D "PreChange"; $rightCol[$rightRow++] =3D $_; } } elsif ($diffcode eq '-') { $state =3D "PreChangeRemove"; $leftCol[$leftRow++] =3D $_; } else { # empty diffcode flush_diff_rows \@leftCol, \@rightCol, = $leftRow, $rightRow; print "\n\n\n\n"; $state =3D "dump"; $leftRow =3D 0; $rightRow =3D 0; } } } close($fh); flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow; # state is empty if we didn't have any change if (!$state) { print "\n\n\n"; print "\n"; print "\n\n"; } print "
", "version $rev1"; print ", $date1" if (defined($date1)); print "
Tag: $sym1\n" if ($sym1); print "		", = "version $rev2"; print ", $date2" if (defined($date2)); print "
Tag: $sym2\n" if ($sym1); print "
"; print "\n\n\n\n
Line $oldline"; print " $funname
"; print "		"; print "\n\n\n\n
Line $newline"; print " $funname
\n"; print "
  $_
 $_ $_
 
- No = viewable change -
\n"; print "
\n"; print "
\n"; print "\n\n\n\n"; print "\n
\n"; # print legend print "\n\n\n\n
"; print "Legend:
\n"; print "\n\n\n\n"; print "\n\n\n"; print "\n\n\n\n"; print "
Removed from v.$rev1 
changed lines
 Added in = v.$rev2
\n
\n		"; # Print format selector foreach my $var (keys %input) { next if ($var eq "f"); next if (defined($DEFAULTVALUE{$var}) && $DEFAULTVALUE{$var} eq $input{$var}); print "\n"; } printDiffSelect($use_java_script); print "\n"; print "
\n"; print "
\n"; } sub navigateHeader($$$$$) { my ($swhere, $path, $filename, $rev, $title) =3D @_; $swhere =3D "" if ($swhere eq $scriptwhere); $swhere =3D './' . urlencode($filename) if ($swhere eq ""); # TODO: this should be moved into external CSS file. my $css =3D ''; if ($title eq 'diff') { $css =3D " "; } print < $path$filename - $title - $rev$css $HTML_META $body_tag_for_src "; print ""; print "
EOF print &link($backicon, "$swhere$query#rev$rev"); print "Return to ", &link($filename, = "$swhere$query#rev$rev"), " CVS log"; print " $fileicon$diricon Up to ", &clickablePath($path, 1), "
"; } sub plural_write($$) { my ($num, $text) =3D @_; if ($num !=3D 1) { $text .=3D "s"; } if ($num > 0) { return join (' ', $num, $text); } else { return ""; } } ## # print readable timestamp in terms of # '..time ago' # H. Zeller ## sub readableTime($$) { my ($i, $break, $retval); my ($secs, $long) =3D @_; # this function works correct for time >=3D 2 seconds if ($secs < 2) { return "very little time"; } my %desc =3D ( 1, 'second', 60, 'minute', 3600, 'hour', 86400, 'day', 604800, 'week', 2628000, 'month', 31536000, 'year' ); my @breaks =3D sort { $a <=3D> $b } keys %desc; $i =3D 0; while ($i <=3D $#breaks && $secs >=3D 2 * $breaks[$i]) { $i++; } $i--; $break =3D $breaks[$i]; $retval =3D plural_write(int($secs / $break), $desc{$break}); if ($long =3D=3D 1 && $i > 0) { my $rest =3D $secs % $break; $i--; $break =3D $breaks[$i]; my $resttime =3D plural_write(int($rest / $break), = $desc{$break}); if ($resttime) { $retval .=3D ", $resttime"; } } return $retval; } ## # clickablePath(String pathname, boolean last_item_clickable) # # returns a html-ified path whereas each directory is a link for # faster navigation. last_item_clickable controls whether the # basename (last directory/file) is a link as well ## sub clickablePath($$) { my ($pathname, $clickLast) =3D @_; my $retval =3D ''; if ($pathname eq '/') { # this should never happen - chooseCVSRoot() is # intended to do this $retval =3D "[$cvstree]"; } else { $retval .=3D ' ' . &link("[$cvstree]", sprintf('%s/%s#dirlist', $scriptname, $query)); my $wherepath =3D ''; my ($lastslash) =3D $pathname =3D~ m|/$|; foreach (split (/\//, $pathname)) { $retval .=3D " / "; $wherepath .=3D "/$_"; my ($last) =3D "$wherepath/" eq "/$pathname" || $wherepath eq "/$pathname"; if ($clickLast || !$last) { $retval .=3D &link($_, join ('', $scriptname, urlencode($wherepath), (!$last || $lastslash ? '/' : = ''), $query, (!$last || $lastslash ? = "#dirlist" : "") )); } else { # do not make a link to the current = dir $retval .=3D $_; } } } return $retval; } sub chooseCVSRoot() { print "
\n"; if (2 <=3D @CVSROOT) { my ($k); foreach $k (keys %input) { print "\n" if ($input{$k}) && ($k ne "cvsroot"); } # Form-Elements look wierd in Netscape if the background # isn't gray and the form elements are not placed # within a table ... print "\n\n"; print "\n"; print "\n\n\n
\n\n"; } else { # no choice -- but we need the form to select = module/path, # at least for Netscape print "

\n"; print "CVS Root: [$cvstree]"; } print " \n"; print "\n"; print ""; if (2 <=3D @CVSROOT) { print "

"; } else { print "

"; } print "\n
"; } sub chooseMirror() { # This code comes from the original BSD-cvsweb # and may not be useful for your site; If you don't # set %MIRRORS this won't show up, anyway. scalar(%MIRRORS) or return; # Should perhaps exclude the current site somehow... print "\n

\nThis CVSweb is mirrored in\n"; my @tmp =3D map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS); my $tmp =3D pop(@tmp); if (scalar(@tmp)) { print join(', ', @tmp), ' and '; } print "$tmp.\n

\n"; } sub fileSortCmp() { my ($comp) =3D 0; my ($c, $d, $af, $bf); ($af =3D $a) =3D~ s/,v$//; ($bf =3D $b) =3D~ s/,v$//; my ($rev1, $date1, $log1, $author1, $filename1) =3D = @{$fileinfo{$af}} if (defined($fileinfo{$af})); my ($rev2, $date2, $log2, $author2, $filename2) =3D = @{$fileinfo{$bf}} if (defined($fileinfo{$bf})); if (defined($filename1) && defined($filename2) && $af eq = $filename1 && $bf eq $filename2) { # Two files $comp =3D -revcmp($rev1, $rev2) if ($byrev && $rev1 && = $rev2); $comp =3D ($date2 <=3D> $date1) if ($bydate && $date1 && = $date2); $comp =3D ($log1 cmp $log2) if ($bylog && $log1 && = $log2); $comp =3D ($author1 cmp $author2) if ($byauthor && $author1 && $author2); } if ($comp =3D=3D 0) { # Directories first, then files under version control, # then other, "rogue" files. # Sort by filename if no other criteria available. my $ad =3D ((-d "$fullname/$a") ? 'D' : (defined($fileinfo{$af}) ? 'F' : 'R')); my $bd =3D ((-d "$fullname/$b") ? 'D' : (defined($fileinfo{$bf}) ? 'F' : 'R')); ($c =3D $a) =3D~ s|.*/||; ($d =3D $b) =3D~ s|.*/||; $comp =3D ("$ad$c" cmp "$bd$d"); } return $comp; } # make A url for downloading sub download_url($$;$) { my ($url, $revision, $mimetype) =3D @_; $revision =3D~ s/\b0\.//; if (defined($checkoutMagic) && (!defined($mimetype) || $mimetype ne = "text/x-cvsweb-markup")) { my $path =3D $where; $path =3D~ s|[^/]+$||; $url =3D "$scriptname/$checkoutMagic/${path}$url"; } $url .=3D "?rev=3D$revision"; $url .=3D '&content-type=3D' . urlencode($mimetype) if = (defined($mimetype)); $url; } # Presents a link to download the # selected revision sub download_link($$$;$) { my ($url, $revision, $textlink, $mimetype) =3D @_; my ($fullurl) =3D download_url($url, $revision, $mimetype); $fullurl =3D~ s/:/sprintf("%%%02x", ord($&))/eg; printf '$textlink"; } # Returns a Query string with the # specified parameter toggled sub toggleQuery($$) { my ($toggle, $value) =3D @_; my ($newquery, $var); my (%vars); %vars =3D %input; if (defined($value)) { $vars{$toggle} =3D $value; } else { $vars{$toggle} =3D $vars{$toggle} ? 0 : 1; } # Build a new query of non-default paramenters $newquery =3D ""; foreach $var (@stickyvars) { my ($value) =3D defined($vars{$var}) ? $vars{$var} : ""; my ($default) =3D defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : = ""; if ($value ne $default) { $newquery .=3D "&" if ($newquery ne ""); $newquery .=3D urlencode($var) . "=3D" . = urlencode($value); } } if ($newquery) { return '?' . $newquery; } return ""; } sub urlencode($) { local ($_) =3D @_; s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge; $_; } sub htmlquote($) { local ($_) =3D @_; # Special Characters; RFC 1866 s/&/&/g; s/\"/"/g; s//>/g; $_; } sub htmlunquote($) { local ($_) =3D @_; # Special Characters; RFC 1866 s/"/\"/g; s/<//g; s/&/&/g; $_; } sub hrefquote($) { local ($_) =3D @_; y/ /+/; htmlquote($_) } sub http_header(;$) { my $content_type =3D shift || "text/html"; $content_type .=3D "; charset=3D$charset" if $content_type =3D~ m,^text/, && defined($charset) && = $charset; if (defined($moddate)) { if ($is_mod_perl) { Apache->request->header_out( "Last-Modified" =3D> scalar = gmtime($moddate) . " GMT"); } else { print "Last-Modified: ", scalar = gmtime($moddate), " GMT\r\n"; } } if ($is_mod_perl) { Apache->request->content_type($content_type); } else { print "Content-Type: $content_type\r\n"; } if ($allow_compress && $maycompress) { if ($has_zlib || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} = -1 -c")) ) { if ($is_mod_perl) { = Apache->request->content_encoding("x-gzip"); Apache->request->header_out( Vary =3D> "Accept-Encoding"); Apache->request->send_http_header; } else { print "Content-Encoding: x-gzip\r\n"; print "Vary: Accept-Encoding\r\n" ; #RFC 2068, 14.43 print "\r\n"; # Close headers } $| =3D 1; $| =3D 0; # Flush header output if ($has_zlib) { tie *GZIP, __PACKAGE__, \*STDOUT; } select(GZIP); $gzip_open =3D 1; # print "" if = ($content_type =3D~ m|^text/html\b|); } else { if ($is_mod_perl) { Apache->request->send_http_header; } else { print "\r\n"; # Close headers } print "Unable = to find gzip binary in the \$command_path ($command_path) to = compress output
"; } } else { if ($is_mod_perl) { Apache->request->send_http_header; } else { print "\r\n"; # Close headers } } } sub html_header($) { my ($title) =3D @_; http_header("text/html"); print < $title $HTML_META $body_tag $logo

$title

EOH } sub html_footer() { print "
\n
$address
\n" if $address; print "\n\n"; } sub link_tags($) { my ($tags) =3D @_; my ($ret) =3D ""; my ($fileurl, $filename); ($filename =3D $where) =3D~ s/^.*\///; $fileurl =3D './' . urlencode($filename); foreach my $sym (split (", ", $tags)) { $ret .=3D ",\n" if ($ret ne ""); $ret .=3D &link($sym, $fileurl . toggleQuery('only_with_tag', = $sym)); } return "$ret\n"; } # # See if a module is listed in the config file's @HideModules list. # sub forbidden_module($) { my ($module) =3D @_; local $_; for (@HideModules) { return 1 if $module =3D~ $_; } return 0; } sub forbidden_file($) { my ($path) =3D @_; $path =3D substr($path, length($cvsroot) + 1); local $_; for (@ForbiddenFiles) { return 1 if $path =3D~ $_; } return 0; } # Close the GZIP handle remove the tie. sub gzipclose { if ($gzip_open) { select(STDOUT); close(GZIP); untie *GZIP; $gzip_open =3D 0; } } # implement a gzipped file handle via the Compress:Zlib compression # library. sub MAGIC1() { 0x1f } sub MAGIC2() { 0x8b } sub OSCODE() { 3 } sub TIEHANDLE { my ($class, $out) =3D @_; my ($d) =3D Compress::Zlib::deflateInit( -Level =3D> Compress::Zlib::Z_BEST_COMPRESSION(), -WindowBits =3D> -Compress::Zlib::MAX_WBITS() ) or return undef; my ($o) =3D { handle =3D> $out, dh =3D> $d, crc =3D> 0, len =3D> 0, }; my ($header) =3D pack("c10", MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(), 0, = 0, 0, 0, 0, 0, OSCODE); print {$o->{handle}} $header; return bless($o, $class); } sub PRINT { my ($o) =3D shift; my ($buf) =3D join (defined $, ? $, : "", @_); my ($len) =3D length($buf); my ($compressed, $status) =3D $o->{dh}->deflate($buf); print {$o->{handle}} $compressed if defined($compressed); $o->{crc} =3D Compress::Zlib::crc32($buf, $o->{crc}); $o->{len} +=3D $len; return $len; } sub PRINTF { my ($o) =3D shift; my ($fmt) =3D shift; my ($buf) =3D sprintf($fmt, @_); my ($len) =3D length($buf); my ($compressed, $status) =3D $o->{dh}->deflate($buf); print {$o->{handle}} $compressed if defined($compressed); $o->{crc} =3D Compress::Zlib::crc32($buf, $o->{crc}); $o->{len} +=3D $len; return $len; } sub WRITE { my ($o, $buf, $len, $off) =3D @_; my ($compressed, $status) =3D $o->{dh}->deflate(substr($buf, 0, = $len)); print {$o->{handle}} $compressed if defined($compressed); $o->{crc} =3D Compress::Zlib::crc32(substr($buf, 0, $len), = $o->{crc}); $o->{len} +=3D $len; return $len; } sub CLOSE { my ($o) =3D @_; return if !defined($o->{dh}); my ($buf) =3D $o->{dh}->flush(); $buf .=3D pack("V V", $o->{crc}, $o->{len}); print {$o->{handle}} $buf; undef $o->{dh}; } sub DESTROY { my ($o) =3D @_; CLOSE($o); } su-2.05b# lynx localhost su-2.05b#=20 su-2.05b# pwd /usr/local/www/cgi-bin ------=_NextPart_000_06D0_01C48389.07F63270--