scottk/wlan-lanforge-scripts
1
0
Fork 0
mirror of https://github.com/Telecominfraproject/wlan-lanforge-scripts.git synced 2025-11-01 03:07:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

har-to-portal: able to print out data for requests in reasonable perl format

Browse Source
This commit is contained in:
Jed Reynolds
2019-12-02 23:08:39 -08:00
parent 2a64d0867b
commit 0654205380
1 changed files with 66 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

102
har-to-portal.pl
View File

@@ -16,9 +16,16 @@ use Data::Dumper;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
$SIG{ __WARN__ } = sub { Carp::confess( @_ ) };
#use constant NA => "NA";
use constant NL => "\n";
#use constant Q => '"';
#use constant q => "'";
use constant NL => "\n";
use constant Q => q(");
use constant a => q(');
use constant qQ => qq('");
use constant CS => q(: );
use constant c => q(,);
use constant dQH => q( ." -H ');
use constant CA => q(=>$::curl_args);
use constant MP => q( 'method'=>'POST',);
use constant PD => q( 'post_data'=>);
#use constant nbsp => " ";
$| = 1;
@@ -50,7 +57,7 @@ if (!(defined $::harfile) || !(defined $::outfile)) {
exit(1);
}
die("unable to open $::harfile: $!") unless open(my $fh, "<", $::harfile);
die("unable to open $::harfile: $!") unless open(my $fh, "<", $::harfile);
read $fh, my $har_txt, -s $fh; # should yank that into LANforge::Utils
close $fh;
our $Decoder = JSON->new->utf8;
@@ -77,58 +84,81 @@ our $Decoder = JSON->new->utf8;
#}
## ----- ----- ----- ----- ----- ----- ----- ----- -----
## Creating a plain JSON object is more efficient,
## Creating a plain JSON object is more efficient,
## and more compatible with FF
## ----- ----- ----- ----- ----- ----- ----- ----- -----
my $json = $::Decoder->decode($har_txt);
$::Decoder->canonical(1);
$::Decoder->allow_blessed(1);
#print Dumper(\$json);
my %ordered_entries = ();
print "I see ".(length($json->{log}->{entries}))." entries\n";
foreach my $entry (@{$json->{log}->{entries}}) {
my $request_start = $entry->{startedDateTime};
$ordered_entries{$request_start} = \$entry;
#print Dumper(\$entry);
#print "------------------------------------------------------------------------------------\n";
}
print "------------------------------------------------------------------------------------\n";
print "------------------------------------------------------------------------------------\n";
print "------------------------------------------------------------------------------------\n";
print "------------------------------------------------------------------------------------\n";
my $found_redirect = 0;
my $found_login_post = 0;
die("unable to open $::outfile: $!") unless open($fh, ">", $::outfile);
for my $request_start ( sort keys %ordered_entries ) {
print "Start: $request_start\n";
my $entry = $ordered_entries{$request_start};
#print Dumper($entry);
#print "REF: ".ref($entry);
my $request = $$entry->{request};
#print Dumper($request);
my $ra_headers = $request->{headers};
my $url = $request->{url};
my $method = $request->{method};
print "$method: $url\n";
#print Dumper($request) if ($method eq "POST");
for my $header_e (@$ra_headers) {
print " H: ".$header_e->{name} .": ".$header_e->{value} .NL;
}
if ($method eq "POST") {
print " D: ".$request->{'postData'}->{text} .NL;
}
}
my $entry = $ordered_entries{$request_start};
my $request = $$entry->{request};
my $response = $$entry->{response};
#die("unable to open $::outfile: $!") unless open($fh, ">", $::outfile);
my $req_headers = $request->{headers};
my $res_headers = $response->{headers};
my $req_cookies = $request->{cookies} if (defined $request->{cookies}) || [];
my $res_cookies = $response->{cookies} if (defined $response->{cookies}) || [];
my $url = $request->{url};
my $method = $request->{method};
print $fh "------------------------------------------------------------------------------------\n";
print $fh "$method: $url\n";
print $fh "------------------------------------------------------------------------------------\n";
print $fh "request({'curl_args'".CA;
for my $header_e (@$req_headers) {
print $fh NL.dQH. $header_e->{name} .CS. $header_e->{value} .qQ;
}
print $fh c.NL;
if ($method eq "POST") {
$found_login_post++;
print $fh MP.NL;
print $fh PD.a. $request->{'postData'}->{text} .a.c.NL;
}
print $fh q( 'url'=>).Q. $url .Q.c.NL;
print $fh q( 'print'=>1).NL;
print $fh q[}, \@response);].NL.NL;
for my $req_cookie(@$req_cookies) {
print $fh " request_cookie ";
print $fh "{'".$req_cookie->{name}."'} = '".$req_cookie->{value}."';\n";
}
print $fh NL;
if ($response->{status} == 301 || $response->{status} == 302) {
$found_redirect++;
print $fh "Expect redirect: ".$response->{status}.NL;
}
for my $header_e (@$res_headers) {
print $fh " response_header: ".$header_e->{name} .": ".$header_e->{value} .NL;
}
for my $res_cookie(@$res_cookies) {
print $fh " response_cookie";
print $fh "{'".$res_cookie->{name}."'} = '".$res_cookie->{value}."';\n";
}
} # ~for each request sorted by time
#
# create find_redirect_url()
# create submit_login()
# create interpret_login_response()
# create submit_logout()
close $fh;
###
###
###
###