mirror of
				https://github.com/Telecominfraproject/wlan-lanforge-scripts.git
				synced 2025-10-31 18:58:01 +00:00 
			
		
		
		
	har-to-portal.pl able to parse HAR file
This commit is contained in:
		
							
								
								
									
										129
									
								
								har-to-portal.pl
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										129
									
								
								har-to-portal.pl
									
									
									
									
									
										Executable file
									
								
							| @@ -0,0 +1,129 @@ | ||||
| #!/usr/bin/perl | ||||
| use strict; | ||||
| use warnings; | ||||
| use diagnostics; | ||||
| use Carp; | ||||
| #use Time::HiRes; | ||||
| # wow, this would have been cool but ... nope | ||||
| use Archive::Har(); | ||||
| use Try::Tiny; | ||||
| use Getopt::Long; | ||||
| use utf8; | ||||
| require JSON; | ||||
| require JSON::XS; | ||||
| #use JSON::XS; | ||||
| 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 nbsp => " "; | ||||
| $| = 1; | ||||
|  | ||||
| package main; | ||||
|  | ||||
| my $usage = qq($0 --har {file.jar} # HAR file saved from browser | ||||
|   --out {bot.pm}      # portal bot module to create | ||||
|   --help|-h           # this | ||||
|   ); | ||||
| our $quiet = 1; | ||||
| our $help = 0; | ||||
| our $outfile; | ||||
| our $harfile; | ||||
|  | ||||
| GetOptions ( | ||||
|    'quiet|q:s'          => \$quiet, | ||||
|    'help|h'             => \$help, | ||||
|    'har=s'              => \$::harfile, | ||||
|    'out|o=s'            => \$::outfile, | ||||
| ) || (print($usage) && exit(1)); | ||||
|  | ||||
| if ($help) { | ||||
|   print($usage); | ||||
|   exit(0); | ||||
| } | ||||
|  | ||||
| if (!(defined $::harfile) || !(defined $::outfile)) { | ||||
|   print $usage; | ||||
|   exit(1); | ||||
| } | ||||
|  | ||||
| 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; | ||||
| #print "** $har_txt".NL; | ||||
|  | ||||
|  | ||||
| ## ----- ----- ----- ----- ----- ----- ----- ----- ----- | ||||
| ##  Creating an Archive::HAR is not very efficient | ||||
| ## ----- ----- ----- ----- ----- ----- ----- ----- ----- | ||||
| #$::harfile = Archive::Har->new(); | ||||
| #$::harfile->string($har_txt); | ||||
| #print Dumper($::harfile); | ||||
| #foreach my $log_entry ($::harfile->entries()) { | ||||
| #  print "Log Entry: ".$log_entry->pageref() .NL if ($log_entry->pageref()); | ||||
| #  print "DT: ".$log_entry->started_date_time() .NL if ($log_entry->started_date_time()); | ||||
| #  #print "Request: ".Dumper($log_entry->request()) .NL; | ||||
| #  print "Request Url:".$log_entry->request()->{url} .NL; | ||||
| #  my $headers = $log_entry->request()->{headers}; | ||||
| #  foreach my $header (@$headers) { | ||||
| #    print "Header: ".$header->{name} .NL; | ||||
| #  } | ||||
| #  #print "Response: ".Dumper($log_entry->response()) .NL; | ||||
| #  #print "Server: ".$log_entry->server_ip_address() .NL; | ||||
| #} | ||||
|  | ||||
| ## ----- ----- ----- ----- ----- ----- ----- ----- ----- | ||||
| ##  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"; | ||||
| 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}; | ||||
|   print "URL: $url\n"; | ||||
|   for my $header_e (@$ra_headers) { | ||||
|     print "H: ".$header_e->{name} .": ".$header_e->{value} .NL; | ||||
|   } | ||||
|   last; | ||||
| } | ||||
|  | ||||
| #die("unable to open $::outfile: $!")  unless open($fh, ">", $::outfile); | ||||
|   # create find_redirect_url() | ||||
|    | ||||
|   # create submit_login() | ||||
|    | ||||
|   # create interpret_login_response() | ||||
|    | ||||
|   # create submit_logout() | ||||
| close $fh; | ||||
| ### | ||||
| ### | ||||
| ### | ||||
		Reference in New Issue
	
	Block a user
	 Jed Reynolds
					Jed Reynolds