You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl@perl.apache.org by Colin Kuskie <ck...@dalsemi.com> on 2002/03/13 20:55:49 UTC

Problems migrating from Apache::OutputChain to Apache::Filter

I've been using Apache::OutputChain for stacking output handlers, and
recently needed the caching feature of Apache::Filter, so I've been
switching my modules over to using it instead.

The system is a little convuluted.  Each URI on the site depends
on 3 files, a .html file which contains content, a local navigation
configuration file, and a template.  Using Apache::OutputChain I had a
hacked up version of Apache::SendFile to determine the meets_conditions()
method of the request object.

The modified version of Apache::SendFile seems to be working fine.  I
tested it using this httpd.conf PerlHandler setup:

PerlModule Apache::Filter

<VirtualHost 192.168.0.7>
    DocumentRoot /home/httpd/html
    ServerName sunset.localdomain
    ErrorLog logs/sunset_errors
    CustomLog logs/sunset_access combined

  <Location "/">
    SetHandler perl-script
    PerlSetVar Filter On
    PerlHandler Apache::SendFile
    #PerlHandler Apache::SendFile Apache::NavGraphics
    #PerlHandler Apache::NavGraphics
    PerlSetVar MyTemplate etc/Sunset6.template
    PerlSetVar NavGraphicsDir /navgraphics
  </Location>

</VirtualHost>

Using this module as a filter, I was able to get content from the
server with no problems.

Next, the file went to a hacked up version of Lincoln Stein's
Apache::NavBar program, except it now does dynamic graphic creation for
navigation and templating (that's where the caching comes in).
However, after modifying it to use Apache::Filter it appears to create
an infinite loop inside the server.  Here's a snippet of the access
log:

192.168.0.7 - - [03/Mar/2002:01:12:55 -0800] "GET / HTTP/1.1" 200 - "-" "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:0.9.2.1) Gecko/20010901"
192.168.0.7 - - [03/Mar/2002:01:12:55 -0800] "GET / HTTP/1.1" 200 - "-" "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:0.9.2.1) Gecko/20010901"
192.168.0.7 - - [03/Mar/2002:01:12:55 -0800] "GET / HTTP/1.1" 200 - "-" "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:0.9.2.1) Gecko/20010901"
192.168.0.7 - - [03/Mar/2002:01:12:55 -0800] "GET / HTTP/1.1" 200 - "-" "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:0.9.2.1) Gecko/20010901"
192.168.0.7 - - [03/Mar/2002:01:12:55 -0800] "GET / HTTP/1.1" 200 - "-" "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:0.9.2.1) Gecko/20010901"
192.168.0.7 - - [03/Mar/2002:01:12:55 -0800] "GET / HTTP/1.1" 200 - "-" "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:0.9.2.1) Gecko/20010901"

The server will continue to generate these requests as long as the
browser waits, thousands of them off of a single page request.

I've tried testing this module standalone, and chained with SendFile
and the behavior is the same.  I eventually winnowed the module down
to a handful of lines.  

sub handler {
  my $r = shift;
  $r = $r->filter_register();
  my $fh = $r->filter_input();
  while (<$fh>) {
    print;
    warn ">$_<";
  }
}

The warn shows that the filehandle seems to be empty but infinite in
size since the error_log is full of this:

><
><
><
><
><
><
><
><

I've attached both modules to this email.  I've tried general Google
searches and Google searches through the mod_perl archives and haven't
found anyone else with this or a similar problem.


RH	mod_perl	apache		perl		Apache::Filter
7.2	1.24_01		1.3.20-16	5.6.0-17	1.019

Colin

package Apache::SendFile;

use strict;
use Apache::Constants qw(:response :methods :http);
use Apache::File;
use Apache::Log;
use Apache::Filter;
use Apache::URI;
use File::Basename;
use vars qw( $VERSION );

$VERSION = '0.03';

sub handler {
    my $r = shift;
    $r=$r->filter_register();
    $r->content_type eq 'text/html' || return DECLINED;

    #warn time(), "\n";
    if ((my $rc = $r->discard_request_body) != OK) {
	return $rc;
    }

    if ($r->method_number == M_INVALID) {
        $r->log->error("Invalid method in request ", $r->the_request);
        return NOT_IMPLEMENTED;
    }

    if ($r->method_number == M_OPTIONS) {
        return DECLINED; #http_core.c:default_handler() will pick this up
    }

    if ($r->method_number == M_PUT) {
        return HTTP_METHOD_NOT_ALLOWED;
    }

    unless (-e $r->finfo) {
	$r->log->error("File does not exist: ", $r->filename);
	return NOT_FOUND;
    }

    if ($r->method_number != M_GET) {
        return HTTP_METHOD_NOT_ALLOWED;
    }

    my $fh = Apache::File->new($r->filename);
    unless ($fh) {
        $r->log->error("file permissions deny server access: ",
                       $r->filename);
        return FORBIDDEN; 
    }   

    ##Let Apache check the file modification times for
    ##the source file, navigation config file and the
    ##templates.
    my $navConf = join '/', $r->document_root(),
			    dirname($r->parsed_uri()->path),
			    'navConf.txt';

    my $template = $r->server_root_relative($r->dir_config('MyTemplate'));
		
    $r->update_mtime();
    foreach ($navConf, $template) {
      next unless -e $_;
      $r->update_mtime((stat _)[9]);
    }

    $r->set_last_modified;
    $r->set_etag;

    if((my $rc = $r->meets_conditions) != OK) {
	return $rc;
    }


    #warn "SendFile: Not cached\n";
    $r->header_out("X-Module-Sender" => __PACKAGE__); 
    $r->send_http_header;

    unless ($r->header_only) {
      local $/ = undef;
      my $data = <$fh>;
      print $data;
      warn ">$data<\n";
    }

    return OK;
}


1;

__END__

package Apache::NavGraphics;

##Derived from work by Lincoln Stein in his article
##"A Dynamic Navigation Bar with mod_perl" in
##The Perl Journal, Issue #12, Vol.3, No.4

use strict;
use Apache::Constants qw(:common);
use Apache::File;
use Apache::URI;
use Apache::Filter;
use File::Basename;
use GD;
use Text::Template;

use vars qw( $VERSION );

my %BARS = ();
my %TB = ();

$VERSION = '0.10';

sub handler {
  my $r = shift;
  $r = $r->filter_register();
  my $fh = $r->filter_input();
  while (<$fh>) {
    print;
  }
}


sub load_nav {
  my $r = shift;
  my $uri = $r->parsed_uri();
  my $mod_time;
  my $root = $r->document_root();
  my $localdir = join '' , $root, dirname($uri->path);
  chop $localdir if (substr $localdir, -1, 1 eq '/');
  my $conf_file = join '/', $localdir, 'navConf.txt';
  my $dirname = $r->dir_config('NavGraphicsDir');
  ##We always return an object, even if there's no configuration file
  ##so that the page is wrapped by the header and footer.
  if (-e $conf_file) {
    $mod_time = (stat _)[9];
  }
  else {
    $conf_file = '';
    $mod_time = 0;
  }

  return $BARS{$conf_file} if $BARS{$conf_file} &&  
                              $BARS{$conf_file}->modified >= $mod_time;
  #warn "NavBar: nav not cached\n";
  $BARS{$conf_file} = Apache::NavGraphics::NavBar->new($conf_file, $dirname, $root);
  #warn "NavBar nav: No object\n" unless exists $BARS{$conf_file};
  #warn "NavBar nav: ",$BARS{$conf_file}->modified," >= $mod_time\n";
  return $BARS{$conf_file};

}

sub load_plate {
  my ($r) = @_;
  my $conf_file = $r->server_root_relative($r->dir_config('MyTemplate'));
  my $mod_time;
  if (-e $conf_file) {
    $mod_time = (stat _)[9];
  }
  else {
    $conf_file = '';
    $mod_time = 0;
  }

  return $TB{$conf_file}->template()
    if $TB{$conf_file} && $TB{$conf_file}->modified >= $mod_time;
  #warn "NavBar: plate not cached\n";
  #warn "NavBar plate: No object\n" unless exists $TB{$conf_file};
  $TB{$conf_file} = Apache::NavGraphics::NavTemplate->new($conf_file);
  #warn "NavBar plate: ",$TB{$conf_file}->modified," >= $mod_time\n";
  return $TB{$conf_file}->template();

}

package Apache::NavGraphics::NavBar;

my @size = (179,19);
my @size2 = (161,19);
my @left_nav = map { hex $_ } qw(CC CC 99);
my @text_on  = map { hex $_ } qw(FF FF CC);
my @mouse_on = map { hex $_ } qw(99 99 66);
my @text_off = map { hex $_ } qw(66 66 33);

sub new {                        # create a new NavBar object
  my ($class, $conf_file, $dirname, $root) = @_;
  my (@c, %c, %d);
  unless ($conf_file) {
    return bless { 'labels'   => [],
		   'url'      => {},
		   'table'    => '',
		   'java'     => '',
		   'modified' => 0 }, $class;
  }
  my $fh = Apache::File->new($conf_file) || return;
  local $/ = "\n";
  while (<$fh>) {
    tr/\r//d;
    chomp;
    my (undef, $label, $url) = split /\t/;
    push @c, $label;
    $c{$label} = $url;
  }
  my $self =  bless { 'labels'   => \@c,
		      'url'      => \%c,
		      'table'    => '',
		      'java'     => '',
		      'modified' => (stat $conf_file)[9] }, $class;
  $self->_make_nav($dirname,$root);
  return $self;
}

#return ordered list of all the URLs in the navigation bar
sub url { return $_[0]->{'url'}->{$_[1]} }

#return the label for a particular URL in the bar
sub labels { return @{shift->{'labels'}}; }

#return the modification date of the configuration file
sub modified { return $_[0]->{'modified'}; }

sub table {
  my $self = shift;
  if (@_) {
    $self->{'table'} = shift; 
  }
  else {
    return $self->{'table'};
  }
}

sub java {
  my $self = shift;
  if (@_) {
    $self->{'java'} = shift; 
  }
  else {
    return $self->{'java'};
  }
}

sub _make_nav {
  my ($bar,$dirname,$root) = @_;            #Create the navigation bar
  my @java;
  my @table;
  my @bounds;
  my ($java,$table) = ('','');
  my $num = 1;
  my ($fileOn, $fileOff);
  my $myLabel;
  foreach my $label ($bar->labels) {
    ($fileOff = $label) =~ tr/a-zA-Z0-9_/_/cs;
    $fileOn  = join '_', 'lnav', $fileOff, 'On.png';
    $fileOff = join '_', 'lnav', $fileOff, 'Off.png';
    $fileOff = join '/', $dirname, $fileOff;
    $fileOn  = join '/', $dirname, $fileOn;
    push @java, <<EOJAVA;
  nav${num}On = new Image();
  nav${num}On.src = "$fileOn";

  nav${num}Off = new Image();
  nav${num}Off.src = "$fileOff";

EOJAVA
    my $url   = $bar->url($label);
    push @table, <<EOTABLE;
<tr>
<td background="/images/left_nav_bar_background.png" width="179" height="27" valign="center"><a href="$url" onMouseOver="changeImages('nav$num', 'nav${num}On')"
onMouseOut="changeImages('nav$num', 'nav${num}Off')"><img name="nav$num" src="$fileOff" alt="$label" border="0" width=179 height=19></img></a></td>
</tr>

EOTABLE

    my $imageOff = new GD::Image(@size);

    my $white     = $imageOff->colorAllocate(255,255,255);
    my $left_nav  = $imageOff->colorAllocate(@left_nav);
    my $text_off  = $imageOff->colorAllocate(@text_off);

    $imageOff->filledRectangle(0,0,@size,$white);
    $imageOff->filledRectangle(0,0,@size2,$left_nav);
    ##Allowed width 153
    @bounds = GD::Image->stringTTF($text_off,
                         '/usr/X11R6/lib/X11/fonts/webfonts/arialb.ttf',
		         8,0,8,13,$label);
    if ($bounds[2] - $bounds[0] > 153) {
      $myLabel = "Too long"; 
    }
    else {
      $myLabel = $label;
    }
    $imageOff->stringTTF($text_off,
                         '/usr/X11R6/lib/X11/fonts/webfonts/arialb.ttf',
		         8,0,8,13,$myLabel);

    my $imageOn = new GD::Image(@size);

    $white        = $imageOn->colorAllocate(255,255,255);
    my $text_on   = $imageOn->colorAllocate(@text_on);
    my $mouse_on  = $imageOn->colorAllocate(@mouse_on);

    $imageOn->filledRectangle(0,0,@size,$white);
    $imageOn->filledRectangle(0,0,@size2,$mouse_on);
    $imageOn->stringTTF($text_on,
                        '/usr/X11R6/lib/X11/fonts/webfonts/arialb.ttf',
		        8,0,8,13,$myLabel);

    $fileOff = join '/', $root, $fileOff;
    $fileOn  = join '/', $root, $fileOn;
    my $onFH = Apache::File->new(">$fileOn") or
      warn "Problem with opening $fileOn: $!\n";
    print $onFH $imageOn->png;
    $onFH->close;
    my $offFH = Apache::File->new(">$fileOff") or
      warn "Problem with opening $fileOff: $!\n";
    print $offFH $imageOff->png;
    $offFH->close;

    ++$num;
  }
  $bar->table(join "", @table);
  $bar->java(join "", @java);

}

package Apache::NavGraphics::NavTemplate;

sub new {
  my ($class, $templateFile) = @_;
  unless ($templateFile) {
    return bless { 'template' => '',
		   'modified' => 0 }, $class;
  }
  my $fh = Apache::File->new($templateFile) || return;
  my $template = Text::Template->new(
				   TYPE   => 'FILEHANDLE',
				   SOURCE => $fh,
				   DELIMITERS => ['{{', '}}']
                                 )
    or warn "Problem with template: $Text::Template::ERROR\n";
  return bless { 'template' => $template,
		 'modified' => (stat $templateFile)[9] }, $class;

}

sub template { return $_[0]->{'template'}; }
sub modified { return $_[0]->{'modified'}; }

1;

__END__

=head1 NAME

B<Apache::NavBar> - A mod_perl plugin for templating HTML pages and automatic
navigation

=head1 SYNOPSIS

  <Location "/">
    SetHandler perl-script
    PerlHandler B<Apache::NavBar>
    PerlSetVar TBTemplate etc/main
  </Location>

find /home/httpd/html -name 'navConf.txt' -print

  /home/httpd/html/sunset/About/navConf.txt
  /home/httpd/html/sunset/Adults/navConf.txt
  /home/httpd/html/sunset/CareGroups/navConf.txt
  /home/httpd/html/sunset/ContactUs/navConf.txt
  /home/httpd/html/sunset/Men/navConf.txt
  /home/httpd/html/sunset/Life/navConf.txt
  /home/httpd/html/sunset/Missions/navConf.txt
  /home/httpd/html/sunset/MusicAndWorship/navConf.txt
  /home/httpd/html/sunset/Seniors/navConf.txt
  /home/httpd/html/sunset/Women/H2H/navConf.txt
  /home/httpd/html/sunset/Women/SNWWN/navConf.txt
  /home/httpd/html/sunset/Women/navConf.txt
  /home/httpd/html/sunset/navConf.txt

=head1 DESCRIPTION

A long time ago, Sunset Presbyterian Church's web server was running on
ISS and used a Visual Basic ASP script for templating and navigation.
It worked, but had problems dealing with filenames with spaces and all
URL's looked like this:

http://www.sunsetpres.org/Main.ASP?name=myDirectory/myFileName.html

instead of the usual

http://www.sunsetpres.org/myDirectory/myFileName.html

The ASP was set up to guarantee a consistent look and feel to all pages
and to ease the generation of navigation bars.  It consistently looked
at one configuration file for its navigation information.

It was decided to migrate the server to a Linux server running Apache to
increase uptime (the SBS had to be rebooted weekly) and decrease cost
(Red Hat Linux (free) versus Microsoft SBS (several hundred dollars)).
However, we needed to duplicate the functionality of the ASP script.
Luckily I had access to a module written by Lincoln Stein in one of his
many Perl Journal articles, B<Apache::NavBar>.

B<Apache::NavBar> was originally designed to automate the generation of
navigation bars on a directory by directory basis.  Configuration was
handled via variables set in the Apache httpd.conf file with one variable
per directory.  If a given directory didn't have a variable set then it
was either blank or inherited the value of its parent directory (if any).
All it really needed to meet our needs was the ability to do templating
and a little more freedom in configuration.

There are two classic ways of coding templates.  The first, which Apache
can support natively, is wrapping a header and footer around an HTML
file fragment.  Usually the header and footer contain the HTML start
and end tags and the HEAD tags so the physical page cannot be read or
verified by itself.  It also cannot have a customized TITLE or META tags.
However, this is usually the fastest and most light weight way to
add templates.

The other way is to have code embedded in the HTML pages that is parsed
and executed by the server as the page is served.  This is extremely
powerful and is the most common way of generating templates.  However,
it is also very memory and processor intensive and generally complex.

We needed something in between.  Something powerful, yet simple and
friendly enough that coders of any skill level could use it and light
weight so it didn't bog down our server.  With only slight changes to
the original B<Apache::NavBar> I was able to meet all of those needs
as well as giving volunteers the ability to affect the navigation in
their areas.  This has many benefits (no one person is saddled with
maintaining the navigation) and downsides (it's a significant amount of
responsibility to be placed in the hands of volunteers and a concern in
enforcing consistent page styles and appearances).

The original B<Apache::NavBar> worked by wrapping all the HTML code
between the starting and ending <BODY> tags in a <TABLE> where the first
row contained table cells with navigation links.  I modified this so
that it not only wrapped that HTML code but overwrote the <BODY> tag to
guarantee a uniform appearance.  Additionally, it uses a sophisticated
set of tables to create a header, vertical left navigation bar and footer
with contact information.  Note that this set of tables was the same as
that created by the original ASP.

Instead of the static table used by the original ASP and the per-directory
configuration variables used by the original B<Apache::NavBar> used for
navigation links, the new B<Apache::NavBar> looks in the same directory
as the requested page for a file named navConf.txt (the format for this
file will be described below) with a series of links for navigation.
It translates those links into a table cell to be used in the vertical
navigation bar.  All style information for this is hard coded in the
module in the B<Apache::NavBar::make_bar> subroutine.  If no file is
found then no nav is made.

Next it loads two template files, one for the header (or top) and one for
the footer (or bottom) and pastes them below and above the starting and
ending <BODY> tags, respectively.  The page's <BODY> tag is overwritten
by the template <BODY> tag.  This template <BODY> tag and exact pasting
locations are hardcoded into the module and are described by a series
of regular expressions in the B<Apache::NavBar::handler> subroutine.

The <TITLE> tag is parsed and its contents is added to the top of the
page after the templatized HTML header as a header.  The style for this is
hard coded into the module in the B<Apache::NavBar::make_bar> subroutine.

=head1 CONFIGURATION

After reading the above, you're probably wondering what's left to
be configurable and how to do it.  The header, footer and links in
the navigation area are all configurable via files.  This causes some
difficulty as style and content information is spread in several places
(four to be exact, two files for the header and footer, one file for
the navigation and the contents of the module itself) but I haven't yet
figured out a way around it.  As you might guess, most of the development
has been driven by immediate need and inspired by God.

Very little, if any,  of the hardcoded style is set in stone and can be
modified to suit the needs of the site.

=head2 Header and Footer

The header and footer for each page is configurable on a per-directory
basis (if need be) by configuration variables in the Apache httpd.conf
file.  The variable is B<TBTemplate> and is set with the following
syntax:

PerlSetVar TBTemplate F<path>/F<file>

F<path> is relative to the server root and B<Apache::NavBar> expects to
find two files, F<file.top> and F<file.bot> for the header and footer
information, respectively.

The header and footer information is cached on a file by file basis to
reduce file I/O and increase plugin efficiency.

=head2 navConf.txt file format

The basic format is one navigation link per line with individual
fields tab separated.  Currently there are three fields:

=over 4

=item 1

What's displayed.  This can include HTML code for altering appearance.
It would be very simple to forbid HTML code to guarantee a consistent
nav style.

=item 2

The URL that's linked.  Together 1 and 2 can be thought of to create
an anchor tag that looks like this:

<A HREF="2">1</A>

=item 3

In indicator of the level of the link that changes it's size.  There are
only two valid levels, 0 and 1.  1 has a smaller size.

=back

Text only elements can be created in the navigation area by leaving
the URL field blank.

The configuration file should be tolerant of DOS style carriage return
line endings.

F<navConf.txt> data is cached to reduce file I/O and increase the
efficiency of the plugin.

=head2 Sunset Header and Footer Configuration

There is only one template file for the entire site:

PerlSetVar TBTemplate etc/main

Since the server root is F</etc/httpd> that makes the path to the config
files F</etc/httpd/etc>.  The files are F<main.top> and F<main.bot>. On
the server, this directory is only accessible to those people with
shell access.

=head1 AUTHOR

Colin Kuskie ckuskie@sterlink.net

=head1 SEE ALSO

Derived from work by Lincoln Stein in his article "A Dynamic Navigation
Bar with mod_perl" in The Perl Journal, Issue #12, Vol.3, No.4

=cut


----- End forwarded message -----

----- End forwarded message -----
------------------------------------------------------------------------------
Support PLUG and the Open Source Community http://www.linuxfund.org/lugs/?lug=plug
To unsubscribe from the PLUG list visit http://www.pdxlinux.org/mailing_list/

----- End forwarded message -----