File Coverage

blib/lib/ReverseProxy/FormFiller.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package ReverseProxy::FormFiller;

use strict;
use Apache2::Filter;
use Apache2::Const -compile => qw(:common);
use Apache2::RequestUtil;
use Apache2::RequestRec;
use Apache2::Log;
use URI::Escape;

our $VERSION = '0.3';

my $globalParams;

sub logError {
    my ($r, $error) = @_;
    $r->log->error("ReverseProxy::FormFiller is not configured, since $error");
}

sub getParams {
    my $r = shift;
    my $paramFile = $r->dir_config('FormFillerParamFile');
    unless (defined $paramFile) {
        &logError($r, "there is no perl var FormFillerParamFile defined in Apache config");
        return 0;
    }
    unless (defined $globalParams->{$paramFile}) {
        if (open F, $paramFile) {
            local $/ = undef;
            my $paramContent = ;
            close F;
            my $params;
            eval "\$params = {$paramContent}";
            if ($@) {
                &logError($r, "$paramFile content doesn't seem to be a valid perl hash");
                $globalParams->{$paramFile} = 0;
            } else {
                $params->{form}       ||= 'form:first';
                $params->{submit}     ||= 'false';
                $params->{javascript} ||= '';
                $params->{publicFormData}   ||= {};
                $params->{publicFilledData} ||= {};
                $params->{secretFormData}   ||= {};
                $params->{postDataSub}      ||= [];
                %{ $params->{secretFormData} } = (
                    %{ $params->{publicFormData} },
                    %{ $params->{secretFormData} }
                );
                $globalParams->{$paramFile} = $params;
            }
        } else {
            &logError($r, "Apache can't read $paramFile");
            $globalParams->{$paramFile} = 0;
        }
    }
    return $globalParams->{$paramFile};
}

## forge javascript to fill and submit form
sub js {
    my $params = shift;
    my ($form, $submit) = ($params->{form}, $params->{submit});
    eval "\$form = $form";
    eval "\$submit = $submit";
    my $js = "  var form = jQuery('$form')\n"
           . "  form.attr('autocomplete', 'off')\n";
    while ( my ($name, $value) = each %{ $params->{publicFormData} } ) {
        eval "\$value = $value";
        $js .= "  form.find('input[name=$name], select[name=$name], textarea[name=$name]').val('$value')\n";
    }
    while ( my ($name, $value) = each %{ $params->{publicFilledData} } ) {
        eval "\$value = $value";
        $js .= "  form.find('$name').val('$value')\n";
    }
    if ($params->{javascript}) {
      my $javascript = $params->{javascript};
      $javascript =~ s/"/\\"/g;
      eval "\$javascript = \"$javascript\"";
      $js .= "$javascript\n";
    }
    $js .= $submit eq "true"  ? "  form.submit()\n"
         : $submit ne "false" ? "  form.find('$submit').click()\n"
         : "";
    $js = "\n" </td>
</tr>

<tr>
<td  class="h" >
<a name="85">85</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">         . "/* script added by ReverseProxy::FormFiller */\n" </td>
</tr>

<tr>
<td  class="h" >
<a name="86">86</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">         . "jQuery(window).load(function() {\n$js})\n" </td>
</tr>

<tr>
<td  class="h" >
<a name="87">87</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">         . "\n";
    $js = "\n$js"
        if ($params->{jQueryUrl});
    return $js;
}

## filter applied to response body
sub output {
    my $f = shift;
    my $buffer;
    my $params = &getParams($f->r);

    # Filter only html reponse body
    unless (
        (!defined $f->r->content_type or $f->r->content_type =~ /html/i)
      && $params
    ) {
        $f->print($buffer) while ($f->read($buffer));
        return Apache2::Const::OK;
    }

    my $body = $f->ctx || "";
    $body .= $buffer while ($f->read($buffer));
    unless ($f->seen_eos) {
        $f->ctx($body);
    } else {
        $f->r->subprocess_env;
        my $js = &js($params);
        $body =~ s/(<\/head>)/$js$1/i or $body =~ s/()/$1$js/i;
        $f->print($body);
    }
    return Apache2::Const::OK;
}

## filter applied to request body
sub input {
    my $f = shift;
    my $buffer;
    my $params = &getParams($f->r);

    # Filter only POST request body
    unless ($f->r->method eq "POST" && $params) {
        $f->print($buffer) while ($f->read($buffer));
        return Apache2::Const::OK;
    }

    my $body = $f->ctx || "";
    $body .= $buffer while ($f->read($buffer));
    unless ($f->seen_eos) {
        $f->ctx($body);
    } else {
        $f->r->subprocess_env;
        while ( my ($name, $value) = each %{ $params->{secretFormData} } ) {
            eval "\$value = $value";
            $name  = uri_escape $name;
            $value = uri_escape $value;
            $body =~ s/$name=.*?((?:&|$))/$name=$value$1/;
        }
        foreach my $sub ( @{ $params->{postDataSub} } ) {
            eval "\$body =~ $sub";
        }
        $f->print($body);
    }
    return Apache2::Const::OK;
}

1;

__END__