Apache-HeavyCGI

 view release on metacpan or  search on metacpan

lib/Apache/HeavyCGI.pm  view on Meta::CPAN

    for my $s (@sel) {
      if ($s eq $value) {
	$checked = 1;
	last;
      }
    }
  } else {
    $checked = $arg{checked};
  }
  sprintf(qq{<input type="checkbox" name="%s" value="%s"%s />},
	  $self->escapeHTML($name),
	  $self->escapeHTML($value),
	  $checked ? qq{ checked="checked"} : ""
	 );
}

# pause_1999::main
sub checkbox_group {
  my($self,%arg) = @_;

  my $name = $arg{name};
  my @sel = $self->{CGI}->param($name);

lib/Apache/HeavyCGI.pm  view on Meta::CPAN

    if (exists $arg{default}) {
      my $default = $arg{default};
      @sel = ref $default ? @$default : $default;
    }
  }

  my %sel;
  @sel{@sel} = ();
  my @m;

  $name = $self->escapeHTML($name);

  my $haslabels = exists $arg{labels};
  my $linebreak = $arg{linebreak} ? "<br />" : "";

  for my $v (@{$arg{values} || []}) {
    push(@m,
	 sprintf(
		 qq{<input type="checkbox" name="%s" value="%s"%s />%s%s},
		 $name,
		 $self->escapeHTML($v),
		 exists $sel{$v} ? qq{ checked="checked"} : "",
		 $haslabels ? $arg{labels}{$v} : $self->escapeHTML($v),
		 $linebreak,
		)
	);
  }
  join "", @m;
}

sub escapeHTML {
  my($self, $what) = @_;
  return unless defined $what;
  my %escapes = qw(& &amp; " &quot; > &gt; < &lt;);
  $what =~ s[ ([&"<>]) ][$escapes{$1}]xg; # ]] cperl-mode comment
  $what;
}

sub file_field {
  my($self) = shift;
  $self->text_pw_field(FIELDTYPE=>"file", @_);
}

sub hidden_field {
  my($self) = shift;

lib/Apache/HeavyCGI.pm  view on Meta::CPAN

  my $checked;
  my $sel = $self->{CGI}->param($name);
  my $haslabels = exists $arg{labels};
  my $values = $arg{values} or Carp::croak "radio_group called without values";
  defined($checked = $arg{checked})
      or defined($checked = $sel)
	  or defined($checked = $arg{default})
	      or $checked = "";
  # some people like to check the first item anyway:
  #	  or ($checked = $values->[0]);
  my $escname=$self->escapeHTML($name);
  my $linebreak = $arg{linebreak} ? "<br />" : "";
  my @m;
  for my $v (@$values) {
    my $escv = $self->escapeHTML($v);
    if ($DEBUG) {
      warn "escname undef" unless defined $escname;
      warn "escv undef" unless defined $escv;
      warn "v undef" unless defined $v;
      warn "\$arg{labels}{\$v} undef" unless defined $arg{labels}{$v};
      warn "checked undef" unless defined $checked;
      warn "haslabels undef" unless defined $haslabels;
      warn "linebreak undef" unless defined $linebreak;
    }
    push(@m,

lib/Apache/HeavyCGI.pm  view on Meta::CPAN

  if (!@sel && exists $arg{default} && defined $arg{default}) {
    my $d = $arg{default};
    @sel = ref $d ? @$d : $d;
  }
  my %sel;
  @sel{@sel} = ();
  my @m;
  push @m, sprintf qq{<select name="%s"%s%s>}, $name, $size, $multiple;
  $arg{values} = [$arg{value}] unless exists $arg{values};
  for my $v (@{$arg{values} || []}) {
    my $escv = $self->escapeHTML($v);
    push @m, sprintf qq{<option%s value="%s">%s</option>\n},
	exists $sel{$v} ? q{ selected="selected"} : "",
	    $escv,
		$haslabels ? $self->escapeHTML($arg{labels}{$v}) : $escv;
  }
  push @m, "</select>";
  join "", @m;
}

# pause_1999::main
sub submit {
  my($self,%arg) = @_;
  my $name = $arg{name} || "";
  my $val  = $arg{value} || $name;
  sprintf qq{<input type="submit" name="%s" value="%s" />},
      $self->escapeHTML($name),
	  $self->escapeHTML($val);
}

# pause_1999::main
sub textarea {
  my($self,%arg) = @_;
  my $req = $self->{CGI};
  my $name = $arg{name} || "";
  my $val  = $req->param($name) || $arg{default} || $arg{value} || "";
  my($r)   = exists $arg{rows} ? qq{ rows="$arg{rows}"} : '';
  my($c)   = exists $arg{cols} ? qq{ cols="$arg{cols}"} : '';
  my($wrap)= exists $arg{wrap} ? qq{ wrap="$arg{wrap}"} : '';
  sprintf qq{<textarea name="%s"%s%s%s>%s</textarea>},
      $self->escapeHTML($name),
	  $r, $c, $wrap, $self->escapeHTML($val);
}

# pause_1999::main
sub textfield {
  my($self) = shift;
  $self->text_pw_field(FIELDTYPE=>"text", @_);
}

sub text_pw_field {
  my($self, %arg) = @_;

lib/Apache/HeavyCGI.pm  view on Meta::CPAN

  } else {
    $val = $req->param($name);
  }
  defined $val or
      defined($val = $arg{value}) or
	  defined($val = $arg{default}) or
	      ($val = "");

  sprintf qq{<input type="$fieldtype"
 name="%s" value="%s"%s%s />},
      $self->escapeHTML($name),
	   $self->escapeHTML($val),
	       exists $arg{size} ? " size=\"$arg{size}\"" : "",
		   exists $arg{maxlength} ? " maxlength=\"$arg{maxlength}\"" : "";
}

sub uri_escape {
  my Apache::HeavyCGI $self = shift;
  my $string = shift;
  return "" unless defined $string;
  require URI::Escape;
  my $s = URI::Escape::uri_escape($string, '^\w ');
  $s =~ s/ /+/g;
  $s;
}

sub uri_escape_light {
  my Apache::HeavyCGI $self = shift;
  require URI::Escape;
  URI::Escape::uri_escape(shift,q{<>#%"; \/\?:&=+,\$}); #"
}

1;

=head1 NAME

Apache::HeavyCGI - Framework to run complex CGI tasks on an Apache server

=head1 SYNOPSIS

lib/Apache/HeavyCGI/UnmaskQuery.pm  view on Meta::CPAN

    warn "UnmaskQuery(v$VERSION): u1[$u1]u2[$u2]" if AHU_DEBUG;
  } elsif ($uri =~ /\?/) {
    my $args = $r->args;
    if ($args =~ /&/ and $args =~ s/;/&/g) { # don't mix!
      $r->args($args);
      warn "UnmaskQuery(v$VERSION): args[$args]" if AHU_DEBUG;
    } else {
      warn "UnmaskQuery(v$VERSION): nothing" if AHU_DEBUG;
    }
  } elsif ( my($u1,$u2) = $uri =~ m/^(.*?)%3[Bb](.*)$/ ) {
    # protect against old proxies that escape volens nolens
    $r->uri($u1);
    $u2 =~ s/%3B/;/gi;
    $u2 =~ s/%26/;/gi; # &
    $u2 =~ s/%3D/=/gi;
    $r->args($u2);
    warn "UnmaskQuery(v$VERSION): oldproxy-u1[$u1]u2[$u2]"
	if 1||AHU_DEBUG;
  }

  DECLINED;

lib/Apache/HeavyCGI/UnmaskQuery.pm  view on Meta::CPAN

URI with a questionmark (unless that URI does already contain a
questionmark). As this is being done in the very early stage of
apache's handling phase, namely in a PerlPostReadRequestHandler, all
subsequent phases can be tricked into seeing the request as a query.

Unfortunately the last paragraph is not completely true. Apache 1.3.4
is not allowing C<%2F> (a slash in ASCII) and C<%00> (a binary 0) in
the I<path> section of the HTTP URI, only in the I<searchoart>
section. Apparently the URL is parsed before the during read_request....

    Breakpoint 1, 0x80b9d05 in ap_unescape_url ()
    (gdb) bt
    #0  0x80b9d05 in ap_unescape_url ()
    #1  0x80b5a56 in ap_some_auth_required ()
    #2  0x80b5fb0 in ap_process_request ()
    #3  0x80adbcd in ap_child_terminate ()
    #4  0x80add58 in ap_child_terminate ()
    #5  0x80adeb3 in ap_child_terminate ()
    #6  0x80ae490 in ap_child_terminate ()
    #7  0x80aecc3 in main ()
    (gdb) c


So if any parameter needs to contain a slash or a binary 0,
we must resort to a different escape method. Now it's turning
ridiculous quickly. I believe, this is a bug in apache and must be
fixed there. But what if the apche group doesn't listen to us?

Easy answer: don't escape slashes if you want to use this technique.
Don't dare to need binary nulls in your parameters. Until it is
figured out if apache group sees this as a bug or not.

=cut