| 178 |
$out->end_section; |
$out->end_section; |
| 179 |
} # generate_info_section |
} # generate_info_section |
| 180 |
|
|
| 181 |
sub generate_transfer_sections ($$) { |
sub generate_transfer_sections ($$) { } |
|
my $self = shift; |
|
|
my $result = shift; |
|
|
|
|
|
$self->generate_http_header_section ($result); |
|
|
} # generate_transfer_sections |
|
|
|
|
|
sub generate_http_header_section ($$) { |
|
|
my ($self, $result) = @_; |
|
|
|
|
|
return unless defined $self->{header_status_code} or |
|
|
defined $self->{header_status_text} or |
|
|
@{$self->{header_field} or []}; |
|
|
|
|
|
my $out = $result->output; |
|
|
|
|
|
$out->start_section (id => 'source-header', title => 'HTTP Header'); |
|
|
$out->html (qq[<p><strong>Note</strong>: Due to the limitation of the |
|
|
network library in use, the content of this section might |
|
|
not be the real header.</p> |
|
|
|
|
|
<table><tbody> |
|
|
]); |
|
|
|
|
|
if (defined $self->{header_status_code}) { |
|
|
$out->html (qq[<tr><th scope="row">Status code</th>]); |
|
|
$out->start_tag ('td'); |
|
|
$out->code ($self->{header_status_code}); |
|
|
} |
|
|
if (defined $self->{header_status_text}) { |
|
|
$out->html (qq[<tr><th scope="row">Status text</th>]); |
|
|
$out->start_tag ('td'); |
|
|
$out->code ($self->{header_status_text}); |
|
|
} |
|
|
|
|
|
for (@{$self->{header_field}}) { |
|
|
$out->start_tag ('tr'); |
|
|
$out->start_tag ('th', scope => 'row'); |
|
|
$out->code ($_->[0]); |
|
|
$out->start_tag ('td'); |
|
|
$out->code ($_->[1]); |
|
|
} |
|
|
|
|
|
$out->end_tag ('table'); |
|
|
|
|
|
$out->end_section; |
|
|
} # generate_http_header_section |
|
| 182 |
|
|
| 183 |
package WebHACC::Input::HTTP; |
package WebHACC::Input::HTTP; |
| 184 |
push our @ISA, 'WebHACC::Input'; |
push our @ISA, 'WebHACC::Input'; |
| 220 |
|
|
| 221 |
unless ($self->host_permit->check ($url_o->uri_host, $url_o->uri_port || 80)) { |
unless ($self->host_permit->check ($url_o->uri_host, $url_o->uri_port || 80)) { |
| 222 |
$self->{error_status_text} = 'Connection to the host is forbidden'; |
$self->{error_status_text} = 'Connection to the host is forbidden'; |
| 223 |
|
bless $self, 'WebHACC::Input::Error'; |
| 224 |
return $self; |
return $self; |
| 225 |
} |
} |
| 226 |
|
|
| 275 |
return $self; |
return $self; |
| 276 |
} # _get_document |
} # _get_document |
| 277 |
|
|
| 278 |
|
sub generate_transfer_sections ($$) { |
| 279 |
|
my $self = shift; |
| 280 |
|
my $result = shift; |
| 281 |
|
|
| 282 |
|
$result->layer_uncertain ('transfer'); |
| 283 |
|
|
| 284 |
|
$self->generate_http_header_section ($result); |
| 285 |
|
} # generate_transfer_sections |
| 286 |
|
|
| 287 |
|
sub generate_http_header_section ($$) { |
| 288 |
|
my ($self, $result) = @_; |
| 289 |
|
|
| 290 |
|
return unless defined $self->{header_status_code} or |
| 291 |
|
defined $self->{header_status_text} or |
| 292 |
|
@{$self->{header_field} or []}; |
| 293 |
|
|
| 294 |
|
my $out = $result->output; |
| 295 |
|
|
| 296 |
|
$out->start_section (id => 'source-header', title => 'HTTP Header'); |
| 297 |
|
$out->html (qq[<p><strong>Note</strong>: Due to the limitation of the |
| 298 |
|
network library in use, the content of this section might |
| 299 |
|
not be the real header.</p> |
| 300 |
|
|
| 301 |
|
<table><tbody> |
| 302 |
|
]); |
| 303 |
|
|
| 304 |
|
if (defined $self->{header_status_code}) { |
| 305 |
|
$out->html (qq[<tr><th scope="row">Status code</th>]); |
| 306 |
|
$out->start_tag ('td'); |
| 307 |
|
$out->code ($self->{header_status_code}); |
| 308 |
|
} |
| 309 |
|
if (defined $self->{header_status_text}) { |
| 310 |
|
$out->html (qq[<tr><th scope="row">Status text</th>]); |
| 311 |
|
$out->start_tag ('td'); |
| 312 |
|
$out->code ($self->{header_status_text}); |
| 313 |
|
} |
| 314 |
|
|
| 315 |
|
for (@{$self->{header_field}}) { |
| 316 |
|
$out->start_tag ('tr'); |
| 317 |
|
$out->start_tag ('th', scope => 'row'); |
| 318 |
|
$out->code ($_->[0]); |
| 319 |
|
$out->start_tag ('td'); |
| 320 |
|
$out->code ($_->[1]); |
| 321 |
|
} |
| 322 |
|
|
| 323 |
|
$out->end_tag ('table'); |
| 324 |
|
|
| 325 |
|
$out->end_section; |
| 326 |
|
} # generate_http_header_section |
| 327 |
|
|
| 328 |
package WebHACC::Input::Text; |
package WebHACC::Input::Text; |
| 329 |
push our @ISA, 'WebHACC::Input'; |
push our @ISA, 'WebHACC::Input'; |
| 330 |
|
|
| 429 |
|
|
| 430 |
sub generate_transfer_sections ($$) { |
sub generate_transfer_sections ($$) { |
| 431 |
my $self = shift; |
my $self = shift; |
|
|
|
|
$self->SUPER::generate_transfer_sections (@_); |
|
| 432 |
|
|
| 433 |
my $result = shift; |
my $result = shift; |
| 434 |
my $out = $result->output; |
my $out = $result->output; |
| 435 |
|
|
| 436 |
$out->start_section (id => 'transfer-errors', title => 'Transfer Errors'); |
$out->start_section (role => 'transfer-errors'); |
| 437 |
|
|
| 438 |
$out->start_tag ('dl'); |
$out->start_tag ('dl'); |
| 439 |
$result->add_error (layer => 'transfer', |
$result->add_error (layer => 'transfer', |
| 449 |
package WebHACC::Input::HTTPError; |
package WebHACC::Input::HTTPError; |
| 450 |
push our @ISA, 'WebHACC::Input::Error', 'WebHACC::Input::HTTP'; |
push our @ISA, 'WebHACC::Input::Error', 'WebHACC::Input::HTTP'; |
| 451 |
|
|
| 452 |
|
sub generate_transfer_sections ($$) { |
| 453 |
|
my $self = shift; |
| 454 |
|
|
| 455 |
|
my $result = shift; |
| 456 |
|
|
| 457 |
|
$self->WebHACC::Input::Error->generate_transfer_sections ($result); |
| 458 |
|
$self->WebHACC::Input::HTTP->generate_transfer_sections ($result); |
| 459 |
|
|
| 460 |
|
} # generate_transfer_sections |
| 461 |
|
|
| 462 |
package WebHACC::Input::UnsupportedURLSchemeError; |
package WebHACC::Input::UnsupportedURLSchemeError; |
| 463 |
push our @ISA, 'WebHACC::Input::Error'; |
push our @ISA, 'WebHACC::Input::Error'; |
| 464 |
|
|