File Coverage

blib/lib/Apache/Motd.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Apache::Motd;
## FILE: Apache/Motd.pm
##       $Id: Motd.pm,v 1.2 2002/11/01 00:39:57 ramirezc Exp $

use strict;
use vars qw($VERSION);
use Apache;
use Apache::Cookie;
use Apache::Constants qw(:common REDIRECT);

$VERSION = '1.00';

sub handler {
    my $r    = shift;
    my $uri  = $r->uri;
    my $cn   = $r->dir_config('CookieName')     || 'seenMOTD';
    my $exp  = $r->dir_config('ExpireCookie')   || '+1d';
    my $file = $r->dir_config('MessageFile')    || 0;
    my $cookieless = $r->dir_config('SupportCookieLess') || 1;
    my $port = ($r->server->port eq '80') ? "" : ':'.$r->server->port;
    my $tquery = $r->args;

    ## If the request is the part of the cookie test redirect, then
    ## take out the ct=1 query_string value and make a note of it
    ## by setting $ct_request
    my $ct_request = 0;
    if ($tquery =~ /ct=1/) {
       $ct_request=1;
       $tquery =~ s/ct=1//;
       $r->args($tquery) if ($tquery =~ /=/);
    }

    return OK unless $r->is_initial_req;

    ## MessageFile appears to be missing, pass onto next phase
    return OK unless $file;
    return OK unless -e $file;

    ## Look for cookie ($cn) and verify it's value
    my $cookies = Apache::Cookie->new($r)->parse;
    if (my $c = $cookies->{$cn}) {
       my $cv = $c->value;
       return OK if ($ct_request == 0  && $cv eq '1');
       displayMotd($r);
       return DONE;
    }

    ## Prepare cookie information and add outgoing headers
    my $cookie = Apache::Cookie->new($r,
                      -name => $cn,-value => '1',-expires => $exp );
    $cookie->bake;

    ## Handle Cookieless clients
    if ($cookieless) {
       ## Apparently this client does not like cookies, pass it on to
       ## next phase
       $r->log_error("Apache::Motd::Bypassed by ".
                     $r->connection->remote_ip) if $ct_request;
       return OK if $ct_request;

       my $host   = $r->hostname;
       my $ct_url = 'http://'.$host.$port.$uri.'?ct=1';
       ## Test for client for cookie worthiness by redirecting client
       ## to same $uri but along with the cookie testflag (ct=1) in the
       ## query_string
       $r->header_out("Location" => $ct_url);
       return REDIRECT;
    }

    displayMotd($r);
    return DONE;
}

sub displayMotd {
    my $r    = shift;
    my $uri  = $r->uri;
    my $file = $r->dir_config('MessageFile');
    my $sec  = $r->dir_config('RedirectInSecs') || 10;

    ## Open motd file, otherwise server error
    unless (open MSG,$file) {
       $r->log_error("Apache::Motd::Error : Unable to load: $file");
       return SERVER_ERROR;
    }

    ## Slurp message $file into a string
    my $msg = "";
    {
      local $/;
      $msg = ;
    }
    close MSG;

    ## Substitute template variables
    $msg =~ s//$uri/g;
    $msg =~ s//$sec/g;

    ## Maintain a small logging trail
    $r->log_error("Apache::Motd::Display URI: $uri ".$r->connection->remote_ip);

    my $headers = $r->headers_out;
       $headers->{'Pragma'} = $headers->{'Cache-control'} = 'no-cache';

    ## straight form the mod_perl guide
    $r->no_cache(1);
    $r->send_http_header('text/html');
    $r->print($msg);
}

1;
__END__