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