From 97aac1e1a7d328076752dd032bca3967b0d22023 Mon Sep 17 00:00:00 2001 From: Leif Hedstrom Date: Mon, 18 Feb 2019 14:26:00 -0700 Subject: [PATCH] Add Perltidy configuration and build target Also does an initial run. --- .perltidyrc | 14 + Makefile.am | 5 +- ci/jenkins/ats_conf.pl | 68 ++-- ci/rat-regex.txt | 1 + lib/perl/examples/forw_proxy_conf.pl | 11 +- lib/perl/lib/Apache/TS/AdminClient.pm | 61 ++- lib/perl/lib/Apache/TS/Config.pm | 6 +- lib/perl/lib/Apache/TS/Config/Records.pm | 66 ++-- plugins/experimental/url_sig/genkeys.pl | 8 +- plugins/experimental/url_sig/sign.pl | 329 +++++++++-------- proxy/http/test_http_client.pl | 390 +++++++++----------- proxy/http/test_proxy.pl | 450 +++++++++++------------ tools/changelog.pl | 223 ++++++----- tools/compare_records.pl | 158 ++++---- tools/compare_servers.pl | 386 +++++++++---------- tools/freelist_diff.pl | 25 +- tools/http_load/merge_stats.pl | 91 ++--- tools/slow_log_report.pl | 104 +++--- tools/traffic_via.pl | 250 ++++++------- 19 files changed, 1304 insertions(+), 1342 deletions(-) create mode 100644 .perltidyrc diff --git a/.perltidyrc b/.perltidyrc new file mode 100644 index 00000000000..86440f5ae93 --- /dev/null +++ b/.perltidyrc @@ -0,0 +1,14 @@ + # This is a simple of a .perltidyrc configuration file + -l=132 # Line length + -i=4 # 4-space indentation + -nlp # Line up params + -ce # cuddle the braces + -tso # Tight secret ops + -nsfs # No space for semicolon + -pt=2 # tight parens + -bt=2 # tight braces + -sbt=2 # tight brackets + -bbt=2 # tight code brackets + -nbbc # No blank lines before comment lines + -otr # No break between a comma and an opening token + -sbl # Empty lane for sub's opening brace diff --git a/Makefile.am b/Makefile.am index 15a411a7709..889be94abc9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -119,7 +119,7 @@ autopep8: # If you make changes to directory structures, you must update this as well. # .PHONY: clang-format-src clang-format-example clang-format-iocore clang-format-lib clang-format-mgmt \ - clang-format-plugins clang-format-proxy clang-format-tools + clang-format-plugins clang-format-proxy clang-format-tools perltidy clang-format: clang-format-src clang-format-example clang-format-iocore clang-format-lib clang-format-mgmt \ clang-format-plugins clang-format-proxy clang-format-tools clang-format-tests @@ -152,6 +152,9 @@ clang-format-tools: clang-format-tests: @$(top_srcdir)/tools/clang-format.sh $(top_srcdir)/tests +perltidy: + perltidy -q -b -bext='/' `find . -name \*.pm -o -name \*.pl` + help: @echo 'all default target for building the package' @echo 'asf-dist recreate source package' diff --git a/ci/jenkins/ats_conf.pl b/ci/jenkins/ats_conf.pl index 0fd0b75c056..83d293e3c26 100755 --- a/ci/jenkins/ats_conf.pl +++ b/ci/jenkins/ats_conf.pl @@ -32,69 +32,69 @@ #$recedit->append(line => "CONFIG proxy.config.crash_log_helper STRING /home/admin/bin/invoker_wrap.sh"); # Port setup -$recedit->set(conf => "proxy.config.http.server_ports", val => "80 80:ipv6 443:ssl 443:ipv6:ssl"); -$recedit->set(conf => "proxy.config.admin.autoconf_port", val => "48083"); +$recedit->set(conf => "proxy.config.http.server_ports", val => "80 80:ipv6 443:ssl 443:ipv6:ssl"); +$recedit->set(conf => "proxy.config.admin.autoconf_port", val => "48083"); $recedit->set(conf => "proxy.config.process_manager.mgmt_port", val => "48084"); # Threads $recedit->set(conf => "proxy.config.exec_thread.autoconfig", val => "0"); -$recedit->set(conf => "proxy.config.exec_thread.limit", val => "8"); +$recedit->set(conf => "proxy.config.exec_thread.limit", val => "8"); $recedit->set(conf => "proxy.config.cache.threads_per_disk", val => "8"); -$recedit->set(conf => "proxy.config.accept_threads", val => "0"); -$recedit->set(conf => "proxy.config.exec_thread.affinity", val => "1"); +$recedit->set(conf => "proxy.config.accept_threads", val => "0"); +$recedit->set(conf => "proxy.config.exec_thread.affinity", val => "1"); # TLS #$recedit->set(conf => "proxy.config.ssl.server.cipher_suite", val => "ECDHE-RSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-RSA-AES128-SHA256:ECDHE-RSA-AES256-SHA384:AES128-GCM-SHA256:AES256-GCM-SHA384:ECDHE-RSA-AES128-SHA:ECDHE-RSA-AES256-SHA:AES128-SHA:AES256-SHA:DES-CBC3-SHA!SRP:!DSS:!PSK:!aNULL:!eNULL:!SSLv2:!RC4"); $recedit->set(conf => "proxy.config.ssl.hsts_max_age", val => "17280000"); #$recedit->set(conf => "proxy.config.ssl.max_record_size", val => "-1"); -$recedit->set(conf => "proxy.config.ssl.session_cache", val => "2"); -$recedit->set(conf => "proxy.config.ssl.ocsp.enabled", val => "1"); +$recedit->set(conf => "proxy.config.ssl.session_cache", val => "2"); +$recedit->set(conf => "proxy.config.ssl.ocsp.enabled", val => "1"); $recedit->set(conf => "proxy.config.http2.stream_priority_enabled", val => "1"); # Cache setup -$recedit->set(conf => "proxy.config.cache.ram_cache.size", val => "1536M"); -$recedit->set(conf => "proxy.config.cache.ram_cache_cutoff", val => "4M"); -$recedit->set(conf => "proxy.config.cache.limits.http.max_alts", val => "4"); -$recedit->set(conf => "proxy.config.cache.dir.sync_frequency", val => "600"); # 10 minutes intervals +$recedit->set(conf => "proxy.config.cache.ram_cache.size", val => "1536M"); +$recedit->set(conf => "proxy.config.cache.ram_cache_cutoff", val => "4M"); +$recedit->set(conf => "proxy.config.cache.limits.http.max_alts", val => "4"); +$recedit->set(conf => "proxy.config.cache.dir.sync_frequency", val => "600"); # 10 minutes intervals $recedit->set(conf => "proxy.config.http.cache.ignore_client_cc_max_age", val => "1"); -$recedit->set(conf => "proxy.config.allocator.hugepages", val => "1"); +$recedit->set(conf => "proxy.config.allocator.hugepages", val => "1"); # HTTP caching related stuff -$recedit->set(conf => "proxy.config.http.cache.required_headers", val => "1"); -$recedit->set(conf => "proxy.config.http.insert_request_via_str", val => "1"); -$recedit->set(conf => "proxy.config.http.insert_response_via_str", val => "2"); -$recedit->set(conf => "proxy.config.http.negative_caching_enabled", val => "1"); +$recedit->set(conf => "proxy.config.http.cache.required_headers", val => "1"); +$recedit->set(conf => "proxy.config.http.insert_request_via_str", val => "1"); +$recedit->set(conf => "proxy.config.http.insert_response_via_str", val => "2"); +$recedit->set(conf => "proxy.config.http.negative_caching_enabled", val => "1"); $recedit->set(conf => "proxy.config.http.negative_caching_lifetime", val => "60"); -$recedit->set(conf => "proxy.config.http.chunking.size", val => "64k"); -$recedit->set(conf => "proxy.config.url_remap.pristine_host_hdr", val => "1"); +$recedit->set(conf => "proxy.config.http.chunking.size", val => "64k"); +$recedit->set(conf => "proxy.config.url_remap.pristine_host_hdr", val => "1"); # Timeouts -$recedit->set(conf => "proxy.config.http.keep_alive_no_activity_timeout_in", val => "300"); -$recedit->set(conf => "proxy.config.http.keep_alive_no_activity_timeout_out", val => "300"); +$recedit->set(conf => "proxy.config.http.keep_alive_no_activity_timeout_in", val => "300"); +$recedit->set(conf => "proxy.config.http.keep_alive_no_activity_timeout_out", val => "300"); $recedit->set(conf => "proxy.config.http.transaction_no_activity_timeout_out", val => "180"); -$recedit->set(conf => "proxy.config.http.transaction_no_activity_timeout_in", val => "180"); -$recedit->set(conf => "proxy.config.http.transaction_active_timeout_in", val => "180"); -$recedit->set(conf => "proxy.config.http.transaction_active_timeout_out", val => "180"); -$recedit->set(conf => "proxy.config.http.accept_no_activity_timeout", val => "30"); +$recedit->set(conf => "proxy.config.http.transaction_no_activity_timeout_in", val => "180"); +$recedit->set(conf => "proxy.config.http.transaction_active_timeout_in", val => "180"); +$recedit->set(conf => "proxy.config.http.transaction_active_timeout_out", val => "180"); +$recedit->set(conf => "proxy.config.http.accept_no_activity_timeout", val => "30"); # DNS / HostDB -$recedit->set(conf => "proxy.config.cache.hostdb.sync_frequency", val => "0"); +$recedit->set(conf => "proxy.config.cache.hostdb.sync_frequency", val => "0"); # Logging -$recedit->set(conf => "proxy.config.log.logging_enabled", val => "3"); -$recedit->set(conf => "proxy.config.log.max_space_mb_for_logs", val => "4096"); -$recedit->set(conf => "proxy.config.log.max_space_mb_headroom", val => "64"); +$recedit->set(conf => "proxy.config.log.logging_enabled", val => "3"); +$recedit->set(conf => "proxy.config.log.max_space_mb_for_logs", val => "4096"); +$recedit->set(conf => "proxy.config.log.max_space_mb_headroom", val => "64"); # Network -$recedit->set(conf => "proxy.config.net.connections_throttle", val => "10000"); -$recedit->set(conf => "proxy.config.net.sock_send_buffer_size_in", val => "4M"); +$recedit->set(conf => "proxy.config.net.connections_throttle", val => "10000"); +$recedit->set(conf => "proxy.config.net.sock_send_buffer_size_in", val => "4M"); $recedit->set(conf => "proxy.config.net.sock_recv_buffer_size_out", val => "4M"); -$recedit->set(conf => "proxy.config.net.poll_timeout", val => "30"); +$recedit->set(conf => "proxy.config.net.poll_timeout", val => "30"); # Local additions (typically not found in the records.config.default) -$recedit->set(conf => "proxy.config.dns.dedicated_thread", val => "0"); -$recedit->set(conf => "proxy.config.http_ui_enabled", val => "3"); -$recedit->set(conf => "proxy.config.http.server_max_connections", val =>"250"); +$recedit->set(conf => "proxy.config.dns.dedicated_thread", val => "0"); +$recedit->set(conf => "proxy.config.http_ui_enabled", val => "3"); +$recedit->set(conf => "proxy.config.http.server_max_connections", val => "250"); #$recedit->set(conf => "proxy.config.mlock_enabled", val => "2"); diff --git a/ci/rat-regex.txt b/ci/rat-regex.txt index 93a24d5b087..18c5c827e59 100644 --- a/ci/rat-regex.txt +++ b/ci/rat-regex.txt @@ -25,6 +25,7 @@ .*\.gold$ ^\.gitignore$ ^\.gitmodules$ +^\.perltidyrc$ ^\.indent.pro$ ^\.vimrc$ ^\.clang-.*$ diff --git a/lib/perl/examples/forw_proxy_conf.pl b/lib/perl/examples/forw_proxy_conf.pl index 9cdd79cdfba..ae25562b232 100755 --- a/lib/perl/examples/forw_proxy_conf.pl +++ b/lib/perl/examples/forw_proxy_conf.pl @@ -18,7 +18,6 @@ use Apache::TS::Config::Records; - ############################################################################ # Simple script, to show some minimum configuration changes typical for # a forward proxy. @@ -26,16 +25,16 @@ my $recedit = new Apache::TS::Config::Records(file => $fn); # Definitely tweak the memory config -$recedit->set(conf => "proxy.config.cache.ram_cache.size", val => "2048M"); +$recedit->set(conf => "proxy.config.cache.ram_cache.size", val => "2048M"); # These puts the server in forward proxy mode only. -$recedit->set(conf => "proxy.config.url_remap.remap_required", val => "0"); -$recedit->set(conf => "proxy.config.reverse_proxy.enabled", val => "0"); +$recedit->set(conf => "proxy.config.url_remap.remap_required", val => "0"); +$recedit->set(conf => "proxy.config.reverse_proxy.enabled", val => "0"); # Fine tuning, you might or might not want these $recedit->set(conf => "proxy.config.http.transaction_active_timeout_in", val => "1800"); -$recedit->set(conf => "proxy.config.dns.dedicated_thread", val => "1"); -$recedit->set(conf => "proxy.config.http.normalize_ae_gzip", val => "1"); +$recedit->set(conf => "proxy.config.dns.dedicated_thread", val => "1"); +$recedit->set(conf => "proxy.config.http.normalize_ae_gzip", val => "1"); # Write out the new config file (this won't overwrite your config $recedit->write(file => "$fn.new"); diff --git a/lib/perl/lib/Apache/TS/AdminClient.pm b/lib/perl/lib/Apache/TS/AdminClient.pm index 5f9aab63717..937d5ce310d 100644 --- a/lib/perl/lib/Apache/TS/AdminClient.pm +++ b/lib/perl/lib/Apache/TS/AdminClient.pm @@ -76,20 +76,16 @@ use constant { TS_ERR_FAIL => 12 }; - # Semi-intelligent way of finding the mgmtapi socket. -sub _find_socket { +sub _find_socket +{ my $path = shift || ""; my $name = shift || "mgmtapi.sock"; my @sockets_def = ( - $path, - Apache::TS::PREFIX . '/' . Apache::TS::REL_RUNTIMEDIR . '/' . 'mgmtapi.sock', - '/usr/local/var/trafficserver', - '/usr/local/var/run/trafficserver', - '/usr/local/var/run', - '/var/trafficserver', - '/var/run/trafficserver', - '/var/run', + $path, Apache::TS::PREFIX . '/' . Apache::TS::REL_RUNTIMEDIR . '/' . 'mgmtapi.sock', + '/usr/local/var/trafficserver', '/usr/local/var/run/trafficserver', + '/usr/local/var/run', '/var/trafficserver', + '/var/run/trafficserver', '/var/run', '/opt/ats/var/trafficserver', ); @@ -104,14 +100,14 @@ sub _find_socket { # # Constructor # -sub new { +sub new +{ my ($class, %args) = @_; my $self = {}; $self->{_socket_path} = _find_socket($args{socket_path}); - $self->{_socket} = undef; - croak -"Unable to locate socket, please pass socket_path with the management api socket location to Apache::TS::AdminClient" + $self->{_socket} = undef; + croak "Unable to locate socket, please pass socket_path with the management api socket location to Apache::TS::AdminClient" if (!$self->{_socket_path}); if ((!-r $self->{_socket_path}) or (!-w $self->{_socket_path}) or (!-S $self->{_socket_path})) { croak "Unable to open $self->{_socket_path} for reads or writes"; @@ -128,7 +124,8 @@ sub new { # # Destructor # -sub DESTROY { +sub DESTROY +{ my $self = shift; return $self->close_socket(); } @@ -136,15 +133,15 @@ sub DESTROY { # # Open the socket (Unix domain) # -sub open_socket { +sub open_socket +{ my $self = shift; my %args = @_; if (defined($self->{_socket})) { if ($args{force} || $args{reopen}) { $self->close_socket(); - } - else { + } else { return undef; } } @@ -152,7 +149,7 @@ sub open_socket { $self->{_socket} = IO::Socket::UNIX->new( Type => SOCK_STREAM, Peer => $self->{_socket_path} - ) or croak("Error opening socket - $@"); + ) or croak("Error opening socket - $@"); return undef unless defined($self->{_socket}); $self->{_select}->add($self->{_socket}); @@ -160,7 +157,8 @@ sub open_socket { return $self; } -sub close_socket { +sub close_socket +{ my $self = shift; # if socket doesn't exist, return as there's nothing to do. @@ -177,10 +175,11 @@ sub close_socket { # # Do reads()'s on our Unix domain socket, takes an optional timeout, in ms's. # -sub _do_read { - my $self = shift; - my $timeout = shift || 1/1000.0; # 1ms by default - my $res = ""; +sub _do_read +{ + my $self = shift; + my $timeout = shift || 1 / 1000.0; # 1ms by default + my $res = ""; while ($self->{_select}->can_read($timeout)) { my $rc = $self->{_socket}->sysread($res, 1024, length($res)); @@ -199,14 +198,14 @@ sub _do_read { return $res || undef; } - # # Get (read) a stat out of the local manager. Note that the assumption is # that you are calling this with an existing stats "name". # -sub get_stat { +sub get_stat +{ my ($self, $stat) = @_; - my $res = ""; + my $res = ""; return undef unless defined($self->{_socket}); return undef unless $self->{_select}->can_write(10); @@ -219,7 +218,7 @@ sub get_stat { my $msg = pack("ll/Z", TS_RECORD_GET, $stat); $self->{_socket}->print(pack("l/a", $msg)); $res = $self->_do_read(); - return undef unless defined($res); # Don't proceed on read failure. + return undef unless defined($res); # Don't proceed on read failure. # The response format is: # MGMT_MARSHALL_INT: message length @@ -235,12 +234,10 @@ sub get_stat { if ($type == TS_REC_INT || $type == TS_REC_COUNTER) { my ($ival) = unpack("q", $value); return $ival; - } - elsif ($type == TS_REC_FLOAT) { + } elsif ($type == TS_REC_FLOAT) { my ($fval) = unpack("f", $value); return $fval; - } - elsif ($type == TS_REC_STRING) { + } elsif ($type == TS_REC_STRING) { my ($sval) = unpack("Z*", $value); return $sval; } diff --git a/lib/perl/lib/Apache/TS/Config.pm b/lib/perl/lib/Apache/TS/Config.pm index 4e9e7aa6289..d4a50078542 100644 --- a/lib/perl/lib/Apache/TS/Config.pm +++ b/lib/perl/lib/Apache/TS/Config.pm @@ -31,7 +31,7 @@ our $VERSION = "1.0"; # Constants use constant { - TS_CONF_UNMODIFIED => 0, - TS_CONF_MODIFIED => 1, - TS_CONF_REMOVED => 2 + TS_CONF_UNMODIFIED => 0, + TS_CONF_MODIFIED => 1, + TS_CONF_REMOVED => 2 }; diff --git a/lib/perl/lib/Apache/TS/Config/Records.pm b/lib/perl/lib/Apache/TS/Config/Records.pm index 5f691138610..078aab87d16 100644 --- a/lib/perl/lib/Apache/TS/Config/Records.pm +++ b/lib/perl/lib/Apache/TS/Config/Records.pm @@ -15,7 +15,6 @@ # See the License for the specific language governing permissions and # limitations under the License. - ############################################################################ # This is a simple module to let you read, modify and add to an Apache # Traffic Server records.config file. The idea is that you would write a @@ -25,7 +24,6 @@ # perldoc for more details. ############################################################################ - package Apache::TS::Config::Records; use Apache::TS::Config; @@ -38,22 +36,22 @@ use Carp; our $VERSION = "1.0"; - # # Constructor # -sub new { +sub new +{ my ($class, %args) = @_; my $self = {}; - my $fn = $args{file}; + my $fn = $args{file}; $fn = $args{filename} unless defined($fn); - $fn = "-" unless defined($fn); + $fn = "-" unless defined($fn); - $self->{_filename} = $fn; # Filename to open when loading and saving - $self->{_configs} = []; # Storage, and to to preserve order - $self->{_lookup} = {}; # For faster lookup, indexes into the above - $self->{_ix} = -1; # Empty + $self->{_filename} = $fn; # Filename to open when loading and saving + $self->{_configs} = []; # Storage, and to to preserve order + $self->{_lookup} = {}; # For faster lookup, indexes into the above + $self->{_ix} = -1; # Empty bless $self, $class; $self->load() if $self->{_filename}; @@ -61,16 +59,16 @@ sub new { return $self; } - # # Load a records.config file # -sub load { +sub load +{ my $self = shift; my %args = @_; - my $fn = $args{file}; + my $fn = $args{file}; - $fn = $args{filename} unless defined($fn); + $fn = $args{filename} unless defined($fn); $fn = $self->{_filename} unless defined($fn); open(FH, "<$fn") || die "Can't open file $fn for reading"; @@ -88,14 +86,14 @@ sub load { } } - # # Get an existing configuration line, as an anon array. # -sub get { +sub get +{ my $self = shift; my %args = @_; - my $c = $args{conf}; + my $c = $args{conf}; $c = $args{config} unless defined($c); my $ix = $self->{_lookup}->{$c}; @@ -104,26 +102,26 @@ sub get { return $self->{_configs}->[$ix]; } - # # Modify one configuration value # -sub set { +sub set +{ my $self = shift; my %args = @_; - my $c = $args{conf}; - my $v = $args{val}; + my $c = $args{conf}; + my $v = $args{val}; $c = $args{config} unless defined($c); - $v = $args{value} unless defined($v); + $v = $args{value} unless defined($v); my $ix = $self->{_lookup}->{$c}; if (!defined($ix)) { - my $type = $args{type}; + my $type = $args{type}; - $type = "INT" unless defined($type); - $self->append(line => "CONFIG $c $type $v"); + $type = "INT" unless defined($type); + $self->append(line => "CONFIG $c $type $v"); } else { my $val = $self->{_configs}->[$ix]; @@ -132,14 +130,14 @@ sub set { } } - # # Remove a configuration from the file. # -sub remove { +sub remove +{ my $self = shift; my %args = @_; - my $c = $args{conf}; + my $c = $args{conf}; $c = $args{config} unless defined($c); @@ -148,11 +146,11 @@ sub remove { $self->{_configs}->[$ix]->[2] = TS_CONF_REMOVED if defined($ix); } - # # Append anything to the "end" of the configuration. # -sub append { +sub append +{ my $self = shift; my %args = @_; my $line = $args{line}; @@ -170,17 +168,17 @@ sub append { $self->{_lookup}->{$p[1]} = $self->{_ix} if ($#p == 3) && (($p[0] eq "LOCAL") || ($p[0] eq "CONFIG")); } - # # Write the new configuration file to STDOUT, or provided # -sub write { +sub write +{ my $self = shift; my %args = @_; - my $fn = $args{file}; + my $fn = $args{file}; $fn = $args{filename} unless defined($fn); - $fn = "-" unless defined($fn); + $fn = "-" unless defined($fn); if ($fn ne "-") { close(STDOUT); diff --git a/plugins/experimental/url_sig/genkeys.pl b/plugins/experimental/url_sig/genkeys.pl index ae5bc0723d0..38cc5235ecc 100755 --- a/plugins/experimental/url_sig/genkeys.pl +++ b/plugins/experimental/url_sig/genkeys.pl @@ -17,11 +17,11 @@ # limitations under the License. my $len = 32; -my @chars = ( 'a' .. 'z', 'A' .. 'Z', '0' .. '9', '_' ); -foreach my $i ( 0 .. 15 ) { +my @chars = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '_'); +foreach my $i (0 .. 15) { my $string = ""; - foreach ( 1 .. $len ) { - $string .= $chars[ rand @chars ]; + foreach (1 .. $len) { + $string .= $chars[rand @chars]; } print "key" . $i . " = " . $string . "\n"; } diff --git a/plugins/experimental/url_sig/sign.pl b/plugins/experimental/url_sig/sign.pl index 6de4cc62eb8..7cf3850dd0c 100755 --- a/plugins/experimental/url_sig/sign.pl +++ b/plugins/experimental/url_sig/sign.pl @@ -22,50 +22,50 @@ use MIME::Base64::URLSafe (); use strict; use warnings; -my $key = undef; -my $string = undef; -my $useparts = undef; -my $result = undef; -my $duration = undef; -my $keyindex = undef; -my $verbose = 0; -my $url = undef; -my $client = undef; -my $algorithm = 1; +my $key = undef; +my $string = undef; +my $useparts = undef; +my $result = undef; +my $duration = undef; +my $keyindex = undef; +my $verbose = 0; +my $url = undef; +my $client = undef; +my $algorithm = 1; my $pathparams = 0; my $sig_anchor = undef; -my $proxy = undef; -my $scheme = "http://"; +my $proxy = undef; +my $scheme = "http://"; $result = GetOptions( - "url=s" => \$url, - "useparts=s" => \$useparts, - "duration=i" => \$duration, - "key=s" => \$key, - "client=s" => \$client, - "algorithm=i" => \$algorithm, - "keyindex=i" => \$keyindex, - "verbose" => \$verbose, - "pathparams" => \$pathparams, - "proxy=s" => \$proxy, - "siganchor=s" => \$sig_anchor + "url=s" => \$url, + "useparts=s" => \$useparts, + "duration=i" => \$duration, + "key=s" => \$key, + "client=s" => \$client, + "algorithm=i" => \$algorithm, + "keyindex=i" => \$keyindex, + "verbose" => \$verbose, + "pathparams" => \$pathparams, + "proxy=s" => \$proxy, + "siganchor=s" => \$sig_anchor ); -if ( !defined($key) || !defined($url) || !defined($duration) || !defined($keyindex) ) { - &help(); - exit(1); -} -if ( defined($proxy) ) { - if ($proxy !~ /http\:\/\/.*\:\d\d/) { +if (!defined($key) || !defined($url) || !defined($duration) || !defined($keyindex)) { &help(); - } + exit(1); +} +if (defined($proxy)) { + if ($proxy !~ /http\:\/\/.*\:\d\d/) { + &help(); + } } if ($url =~ m/^https/) { - $url =~ s/^https:\/\///; - $scheme = "https://"; + $url =~ s/^https:\/\///; + $scheme = "https://"; } else { - $url =~ s/^http:\/\///; + $url =~ s/^http:\/\///; } my $url_prefix = $url; @@ -77,87 +77,90 @@ my @inactive_parts = (); my $query_params = undef; -my $urlHasParams = index($url,"?"); -my $file = undef; +my $urlHasParams = index($url, "?"); +my $file = undef; my @parts = (split(/\//, $url)); my $parts_size = scalar(@parts); if ($pathparams) { - if (scalar(@parts) > 1) { - $file = pop @parts; - } else { - print STDERR "\nERROR: No file segment in the path when using --pathparams.\n\n"; - &help(); - exit 1; - } - if($urlHasParams) { - $file = (split(/\?/, $file))[0]; - } - $parts_size = scalar(@parts); + if (scalar(@parts) > 1) { + $file = pop @parts; + } else { + print STDERR "\nERROR: No file segment in the path when using --pathparams.\n\n"; + &help(); + exit 1; + } + if ($urlHasParams) { + $file = (split(/\?/, $file))[0]; + } + $parts_size = scalar(@parts); } if ($urlHasParams > 0) { - if ( ! $pathparams) { - ($parts[$parts_size -1], $query_params) = (split(/\?/, $parts[$parts_size - 1])); - } else { - $query_params = (split(/\?/, $url))[1]; - } + if (!$pathparams) { + ($parts[$parts_size - 1], $query_params) = (split(/\?/, $parts[$parts_size - 1])); + } else { + $query_params = (split(/\?/, $url))[1]; + } } foreach my $part (@parts) { - if ( length($useparts) > $i ) { - $part_active = substr( $useparts, $i++, 1 ); - } - if ($part_active) { - $string .= $part . "/"; - } - else { - $inactive_parts[$j] = $part; - } - $j++; + if (length($useparts) > $i) { + $part_active = substr($useparts, $i++, 1); + } + if ($part_active) { + $string .= $part . "/"; + } else { + $inactive_parts[$j] = $part; + } + $j++; } my $signing_signature = undef; chop($string); if ($pathparams) { - if ( defined($client) ) { - $signing_signature = ";C=" . $client . ";E=" . ( time() + $duration ) . ";A=" . $algorithm . ";K=" . $keyindex . ";P=" . $useparts . ";S="; - $string .= $signing_signature; - } - else { - $signing_signature = ";E=" . ( time() + $duration ) . ";A=" . $algorithm . ";K=" . $keyindex . ";P=" . $useparts . ";S="; - $string .= $signing_signature; - } -} else { - if ( defined($client) ) { - if ($urlHasParams > 0) { - $signing_signature = "?$query_params" . "&C=" . $client . "&E=" . ( time() + $duration ) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; - $string .= $signing_signature; - } - else { - $signing_signature = "?C=" . $client . "&E=" . ( time() + $duration ) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; - $string .= $signing_signature; - } - } - else { - if ($urlHasParams > 0) { - $signing_signature = "?$query_params" . "&E=" . ( time() + $duration ) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; - $string .= $signing_signature; + if (defined($client)) { + $signing_signature = + ";C=" . $client . ";E=" . (time() + $duration) . ";A=" . $algorithm . ";K=" . $keyindex . ";P=" . $useparts . ";S="; + $string .= $signing_signature; + } else { + $signing_signature = ";E=" . (time() + $duration) . ";A=" . $algorithm . ";K=" . $keyindex . ";P=" . $useparts . ";S="; + $string .= $signing_signature; } - else { - $signing_signature = "?E=" . ( time() + $duration ) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; - $string .= $signing_signature; +} else { + if (defined($client)) { + if ($urlHasParams > 0) { + $signing_signature = + "?$query_params" . "&C=" + . $client . "&E=" + . (time() + $duration) . "&A=" + . $algorithm . "&K=" + . $keyindex . "&P=" + . $useparts . "&S="; + $string .= $signing_signature; + } else { + $signing_signature = + "?C=" . $client . "&E=" . (time() + $duration) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; + $string .= $signing_signature; + } + } else { + if ($urlHasParams > 0) { + $signing_signature = + "?$query_params" . "&E=" . (time() + $duration) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; + $string .= $signing_signature; + } else { + $signing_signature = "?E=" . (time() + $duration) . "&A=" . $algorithm . "&K=" . $keyindex . "&P=" . $useparts . "&S="; + $string .= $signing_signature; + } } - } } my $digest; -if ( $algorithm == 1 ) { - $digest = hmac_sha1_hex( $string, $key ); -} -else { - $digest = hmac_md5_hex( $string, $key ); +if ($algorithm == 1) { + $digest = hmac_sha1_hex($string, $key); +} else { + $digest = hmac_md5_hex($string, $key); } $verbose && print "\nSigned String: $string\n\n"; @@ -165,82 +168,96 @@ $verbose && print "\nsigning_signature: $signing_signature\n"; $verbose && print "\ndigest: $digest\n"; -if ($urlHasParams == -1) { # no application query parameters. - if ( ! defined($proxy)) { - if ( ! $pathparams) { - print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . $signing_signature . $digest . "'\n\n"; - } else { - my $index = rindex($url, '/'); - $url = substr($url,0,$index); - my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); - if (defined($sig_anchor)) { - print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . ";${sig_anchor}=" . $encoded . "/$file" . "'\n\n"; +if ($urlHasParams == -1) { # no application query parameters. + if (!defined($proxy)) { + if (!$pathparams) { + print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . $signing_signature . $digest . "'\n\n"; } else { - print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . "/" . $encoded . "/$file" . "'\n\n"; + my $index = rindex($url, '/'); + $url = substr($url, 0, $index); + my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); + if (defined($sig_anchor)) { + print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . ";${sig_anchor}=" . $encoded . "/$file" . "'\n\n"; + } else { + print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . "/" . $encoded . "/$file" . "'\n\n"; + } } - } } else { - if ( ! $pathparams) { - print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . $signing_signature . $digest . - "'\n\n"; - } else { - my $index = rindex($url, '/'); - $url = substr($url,0,$index); - my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); - if (defined($sig_anchor)) { - print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . ";${sig_anchor}=" . $encoded . "/$file" . "'\n\n"; + if (!$pathparams) { + print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . $signing_signature . $digest . "'\n\n"; } else { - print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . "/" . $encoded . "/$file" . "'\n\n"; + my $index = rindex($url, '/'); + $url = substr($url, 0, $index); + my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); + if (defined($sig_anchor)) { + print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" + . $url + . ";${sig_anchor}=" + . $encoded + . "/$file" . "'\n\n"; + } else { + print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . "/" . $encoded . "/$file" . "'\n\n"; + } } - } } -} else { # has application parameters. +} else { # has application parameters. $url = (split(/\?/, $url))[0]; - if ( ! defined($proxy)) { - if ( ! $pathparams) { - print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . $signing_signature . $digest . "'\n\n"; - } else { - my $index = rindex($url, '/'); - $url = substr($url,0,$index); - my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); - if (defined($sig_anchor)) { - print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . ";${sig_anchor}=" . $encoded . "/" . $file . "?$query_params" - . "'\n\n"; + if (!defined($proxy)) { + if (!$pathparams) { + print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . $signing_signature . $digest . "'\n\n"; } else { - print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . "/" . $encoded . "/" . $file . "?$query_params" - . "'\n\n"; + my $index = rindex($url, '/'); + $url = substr($url, 0, $index); + my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); + if (defined($sig_anchor)) { + print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" + . $url + . ";${sig_anchor}=" + . $encoded . "/" + . $file + . "?$query_params" . "'\n\n"; + } else { + print "curl -s -o /dev/null -v --max-redirs 0 '$scheme" . $url . "/" . $encoded . "/" . $file . "?$query_params" + . "'\n\n"; + } } - } } else { - if ( ! $pathparams) { - print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . $signing_signature . $digest . - "'\n\n"; - } else { - my $index = rindex($url, '/'); - $url = substr($url,0,$index); - my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); - if (defined($sig_anchor)) { - print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . ";${sig_anchor}=" . $encoded . "/" . $file . "?$query_params" - . "'\n\n"; + if (!$pathparams) { + print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . $signing_signature . $digest . "'\n\n"; } else { - print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" . $url . "/" . $encoded . "/$file?$query_params" . "'\n\n"; + my $index = rindex($url, '/'); + $url = substr($url, 0, $index); + my $encoded = MIME::Base64::URLSafe::encode($signing_signature . $digest); + if (defined($sig_anchor)) { + print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" + . $url + . ";${sig_anchor}=" + . $encoded . "/" + . $file + . "?$query_params" . "'\n\n"; + } else { + print "curl -s -o /dev/null -v --max-redirs 0 --proxy $proxy '$scheme" + . $url . "/" + . $encoded + . "/$file?$query_params" . "'\n\n"; + } } - } } } -sub help { - print "sign.pl - Example signing utility in perl for signed URLs\n"; - print "Usage: \n"; - print " ./sign.pl --url \\ \n"; - print " --useparts \\ \n"; - print " --algorithm \\ \n"; - print " --duration \\ \n"; - print " --keyindex \\ \n"; - print " [--client ] \\ \n"; - print " --key \\ \n"; - print " [--verbose] \n"; - print " [--pathparams] \n"; - print " [--proxy ] ex value: http://myproxy:80\n"; - print "\n"; +sub help +{ + print "sign.pl - Example signing utility in perl for signed URLs\n"; + print "Usage: \n"; + print " ./sign.pl --url \\ \n"; + print " --useparts \\ \n"; + print " --algorithm \\ \n"; + print " --duration \\ \n"; + print " --keyindex \\ \n"; + print " [--client ] \\ \n"; + print " --key \\ \n"; + print " [--verbose] \n"; + print " [--pathparams] \n"; + print " [--proxy ] ex value: http://myproxy:80\n"; + print "\n"; } diff --git a/proxy/http/test_http_client.pl b/proxy/http/test_http_client.pl index 68e6d9dde52..24a62811e3d 100644 --- a/proxy/http/test_http_client.pl +++ b/proxy/http/test_http_client.pl @@ -28,7 +28,6 @@ sub make_doc_filename($); sub make_doc_http_filename($); - ########################################################### # # global configuration parameters @@ -44,54 +43,39 @@ ########################################################### sub process_input_http_requests_file($$$) { - my ($filename, $proxy_name, $proxy_port) = @_; - my ($input, $host_name, $host_port, $request, $line); - - #open input file for read - unless (open input, "<$filename") - { - print "cannot open $filename: $!\n"; - return; - } - - while ($line = ) - { - $request .= $line; - #replace \n with \r\n - if (not $line =~ m/\r/) - { - $line =~ s/\n/\r\n/; - } - if ($line =~ m/host/i) - { - ($_, $host_name, $host_port) = split( /:/, $line, 3); - if (not $host_port) - { - $host_port = 80; - } - } - elsif (length($line) <= 2 && $line == "\n") - { - $request .= $line; - if ($proxy_name and $proxy_port) - { - $request = make_proxy_request( - $request, - $host_name, - $host_port, - $proxy_name, - $proxy_port); - spawn_http_request($proxy_name, $proxy_port, $request); - } - else - { - print $request; - spawn_http_request($host_name, $host_port, $request); - } - $request = ""; - } - } - return; + my ($filename, $proxy_name, $proxy_port) = @_; + my ($input, $host_name, $host_port, $request, $line); + + #open input file for read + unless (open input, "<$filename") { + print "cannot open $filename: $!\n"; + return; + } + + while ($line = ) { + $request .= $line; + #replace \n with \r\n + if (not $line =~ m/\r/) { + $line =~ s/\n/\r\n/; + } + if ($line =~ m/host/i) { + ($_, $host_name, $host_port) = split(/:/, $line, 3); + if (not $host_port) { + $host_port = 80; + } + } elsif (length($line) <= 2 && $line == "\n") { + $request .= $line; + if ($proxy_name and $proxy_port) { + $request = make_proxy_request($request, $host_name, $host_port, $proxy_name, $proxy_port); + spawn_http_request($proxy_name, $proxy_port, $request); + } else { + print $request; + spawn_http_request($host_name, $host_port, $request); + } + $request = ""; + } + } + return; } ########################################################### # @@ -100,21 +84,18 @@ ($$$) ########################################################### sub spawn_http_request($$$) { - my($hostname, $hostport, $request) = @_; - - my ($pid); - if (!defined ($pid = fork)) - { - print "fork failed", "\n"; - exit; - } - elsif ($pid) - { # parent - return; - } - # else, I am the child - do_http_request ($hostname, $hostport, $request); - exit; + my ($hostname, $hostport, $request) = @_; + + my ($pid); + if (!defined($pid = fork)) { + print "fork failed", "\n"; + exit; + } elsif ($pid) { # parent + return; + } + # else, I am the child + do_http_request($hostname, $hostport, $request); + exit; } ########################################################### # @@ -123,33 +104,31 @@ ($$$) ########################################################### sub spawn_http_request($$$) { - my ($hostname, $hostport, $request) = @_; - my ($line); - my ($iaddr, $paddr, $proto); - - $hostname =~ s/\s//g; - - $iaddr = inet_aton($hostname) or die "no host: $hostname", "\n"; - $paddr = sockaddr_in($hostport, $iaddr); - $proto = getprotobyname('tcp'); - - unless (socket(Host, PF_INET, SOCK_STREAM, $proto)) - { - print "socket: $!", "\n"; - exit; - } - unless (connect(Host, $paddr)) - { - print "connect: $!", "\n"; - exit; - } - syswrite Host, $request, length($request); - #process response - process_http_response($request, $Host, 1, 1); - print "request is done\n"; - close (Host); - - return; + my ($hostname, $hostport, $request) = @_; + my ($line); + my ($iaddr, $paddr, $proto); + + $hostname =~ s/\s//g; + + $iaddr = inet_aton($hostname) or die "no host: $hostname", "\n"; + $paddr = sockaddr_in($hostport, $iaddr); + $proto = getprotobyname('tcp'); + + unless (socket(Host, PF_INET, SOCK_STREAM, $proto)) { + print "socket: $!", "\n"; + exit; + } + unless (connect(Host, $paddr)) { + print "connect: $!", "\n"; + exit; + } + syswrite Host, $request, length($request); + #process response + process_http_response($request, $Host, 1, 1); + print "request is done\n"; + close(Host); + + return; } ########################################################### # @@ -165,62 +144,52 @@ ($$$) ########################################################### sub process_http_response($$$$) { - my ($request, $Host, $save_doc_flag, $save_http_flag) = @_; - my ($doc_filename, $http_filename); - - my ($doc_filename) = make_doc_filename($request); - my ($doc_http_filename) = make_doc_http_filename($request); - - print $doc_filename, ' ', $doc_http_filename, "\n"; - - my ($doc_file, $doc_http_file); - ######################## - # open files for write # - ######################## - if ($save_doc_flag) - { - unless (open doc_file, ">$doc_filename") - { - print "cannot open $doc_filename for write", "\n"; - return; - } - } - if ($save_http_flag) - { - unless (open doc_http_file, ">$doc_http_filename") - { - print "cannot open $doc_http_filename for write", "\n"; - return; - } - } - ############################## - # write http header and body # - ############################## - my ($http_header) = 1; - my ($doc_body) = 0; - my ($line); - - while ($line = ) - { - if ($http_header) - { - if ($save_http_flag) - { - print doc_http_file $line; - } - if (length($line) <= 2 && $line == "\n") - { - close doc_http_file; - $http_header = 0; - $doc_body = 1; - } - } - elsif ($save_doc_flag) - { - print doc_file $line; - } - } - return; + my ($request, $Host, $save_doc_flag, $save_http_flag) = @_; + my ($doc_filename, $http_filename); + + my ($doc_filename) = make_doc_filename($request); + my ($doc_http_filename) = make_doc_http_filename($request); + + print $doc_filename, ' ', $doc_http_filename, "\n"; + + my ($doc_file, $doc_http_file); + ######################## + # open files for write # + ######################## + if ($save_doc_flag) { + unless (open doc_file, ">$doc_filename") { + print "cannot open $doc_filename for write", "\n"; + return; + } + } + if ($save_http_flag) { + unless (open doc_http_file, ">$doc_http_filename") { + print "cannot open $doc_http_filename for write", "\n"; + return; + } + } + ############################## + # write http header and body # + ############################## + my ($http_header) = 1; + my ($doc_body) = 0; + my ($line); + + while ($line = ) { + if ($http_header) { + if ($save_http_flag) { + print doc_http_file $line; + } + if (length($line) <= 2 && $line == "\n") { + close doc_http_file; + $http_header = 0; + $doc_body = 1; + } + } elsif ($save_doc_flag) { + print doc_file $line; + } + } + return; } ########################################################### # @@ -234,21 +203,20 @@ ($$$$) ########################################################### sub make_proxy_request($$$$$) { - my ($request, $host_name, $host_port, $proxy_name, $proxy_port) = @_; - my ($proxy_request) = $request; + my ($request, $host_name, $host_port, $proxy_name, $proxy_port) = @_; + my ($proxy_request) = $request; - my ($url_prefix) = "http:\/\/$host_name\/"; - $url_prefix =~ s/\s//g; + my ($url_prefix) = "http:\/\/$host_name\/"; + $url_prefix =~ s/\s//g; - if ($host_port != 80) - { - $url_prefix .= ":$host_port\/"; - } - $url_prefix =~ s/\s//g; + if ($host_port != 80) { + $url_prefix .= ":$host_port\/"; + } + $url_prefix =~ s/\s//g; - $proxy_request =~ s/\//$url_prefix/; + $proxy_request =~ s/\//$url_prefix/; - return ($proxy_request); + return ($proxy_request); } ########################################################### # @@ -258,45 +226,44 @@ ($$$$$) ########################################################### sub make_doc_filename($) { - my ($request) = @_; - my ($doc_filename); - my ($host_name); - - ($_, $host_name) = split (/host:/i, $request, 2); - ($host_name, $_) = split (/ /, $host_name); - #replace every . with _ - $host_name =~ s/\./_/g; - - print $request, "\n"; - print $host_name, "\n"; - - ($_, $doc_filename) = split (/ /, $request, 2); - #remove scheme://host_name if this is a proxy request -# if ($doc_filename =~ m/:\/\//) -# { -# -# } -# -# @@@@@@@@ + my ($request) = @_; + my ($doc_filename); + my ($host_name); + + ($_, $host_name) = split(/host:/i, $request, 2); + ($host_name, $_) = split(/ /, $host_name); + #replace every . with _ + $host_name =~ s/\./_/g; - ($_, $doc_filename) = split (/\//, $doc_filename, 2); - $doc_filename =~ s/\//_/g; - #remove any white spaces - $doc_filename =~ s/\s//g; + print $request, "\n"; + print $host_name, "\n"; - print "doc name is: ", $doc_filename, "\n"; + ($_, $doc_filename) = split(/ /, $request, 2); + #remove scheme://host_name if this is a proxy request + # if ($doc_filename =~ m/:\/\//) + # { + # + # } + # + # @@@@@@@@ - if (length($doc_filename) <= 1) - { - $doc_filename = 'default.html'; - } + ($_, $doc_filename) = split(/\//, $doc_filename, 2); + $doc_filename =~ s/\//_/g; + #remove any white spaces + $doc_filename =~ s/\s//g; - $doc_filename = $host_name . '_' . $doc_filename; + print "doc name is: ", $doc_filename, "\n"; - #remove any white spaces - $doc_filename =~ s/\s//g; + if (length($doc_filename) <= 1) { + $doc_filename = 'default.html'; + } - return ($doc_filename); + $doc_filename = $host_name . '_' . $doc_filename; + + #remove any white spaces + $doc_filename =~ s/\s//g; + + return ($doc_filename); } ########################################################### # @@ -305,43 +272,34 @@ ($) ########################################################### sub make_doc_http_filename($) { - my ($request) = @_; - my ($doc_http_filename); + my ($request) = @_; + my ($doc_http_filename); - $doc_http_filename = make_doc_filename($request); - $doc_http_filename .= '.http'; + $doc_http_filename = make_doc_filename($request); + $doc_http_filename .= '.http'; - return ($doc_http_filename); + return ($doc_http_filename); } ########################################################### # # main entry point # ########################################################### -if ($#ARGV != 1 and $#ARGV != 3) -{ - print 'no proxy : test_http_client ', "\n"; - print 'use proxy: test_http_client '; - print ' ', "\n"; - exit; +if ($#ARGV != 1 and $#ARGV != 3) { + print 'no proxy : test_http_client ', "\n"; + print 'use proxy: test_http_client '; + print ' ', "\n"; + exit; } -if ($#ARGV == 1) -{ - my ($infile, $nusers) = @ARGV; - process_input_http_requests_file($infile, "", ""); -} -elsif ($#ARGV == 3) -{ - my ($infile, $nusers, $proxy_name, $proxy_port) = @ARGV; - process_input_http_requests_file($infile, $proxy_name, $proxy_port); +if ($#ARGV == 1) { + my ($infile, $nusers) = @ARGV; + process_input_http_requests_file($infile, "", ""); +} elsif ($#ARGV == 3) { + my ($infile, $nusers, $proxy_name, $proxy_port) = @ARGV; + process_input_http_requests_file($infile, $proxy_name, $proxy_port); } print "\n"; exit; - - - - - diff --git a/proxy/http/test_proxy.pl b/proxy/http/test_proxy.pl index 94de3752ee4..646547703e7 100644 --- a/proxy/http/test_proxy.pl +++ b/proxy/http/test_proxy.pl @@ -29,16 +29,15 @@ sub make_doc_filename($); sub make_doc_http_filename($); - ########################################################### # # global configuration parameters # ########################################################### -glob ($number_of_users) = 1; -glob ($save_http_doc) = 0; #if false (0) don't save a copy - #of the doc and header files. -glob ($method) = "GET"; #method to use in http requests +glob($number_of_users) = 1; +glob($save_http_doc) = 0; #if false (0) don't save a copy + #of the doc and header files. +glob($method) = "GET"; #method to use in http requests ########################################################### # @@ -48,13 +47,13 @@ ########################################################### sub compare_files($$$) { - my ($dfile, $pfile, $log_file) = @_; - @args = ("diff", $dfile, $pfile, ">>", $log_file); + my ($dfile, $pfile, $log_file) = @_; + @args = ("diff", $dfile, $pfile, ">>", $log_file); - #diff returns 0 if files are identical - $is_diff = system (@args); + #diff returns 0 if files are identical + $is_diff = system(@args); - return ($is_diff); + return ($is_diff); } ########################################################### # @@ -68,21 +67,18 @@ ($$$) ########################################################### sub spawn_task($$$$) { - my($hostname, $hostport, $request, $run_task) = @_; - - my ($pid); - if (!defined ($pid = fork)) - { - print "fork failed", "\n"; - exit; - } - elsif ($pid) - { # parent - return; - } - # else, I am the child - run_task ($hostname, $hostport, $request); - exit; + my ($hostname, $hostport, $request, $run_task) = @_; + + my ($pid); + if (!defined($pid = fork)) { + print "fork failed", "\n"; + exit; + } elsif ($pid) { # parent + return; + } + # else, I am the child + run_task($hostname, $hostport, $request); + exit; } ########################################################### # @@ -91,236 +87,214 @@ ($$$$) ########################################################### sub run_proxy_keep_alive { - my ($proxy_host_name, $proxy_port, -} + my ( + $proxy_host_name, $proxy_port,; + } -@@@@@@@@@@ + @@@@@@@@@@ ########################################################### -# -# subroutine: do_http_request hostname request -# + # + # subroutine: do_http_request hostname request + # ########################################################### -sub do_http_request($$$) -{ - my ($hostname, $hostport, $request) = @_; - my ($line); - my ($iaddr, $paddr, $proto); - - $hostname =~ s/\s//g; - - $iaddr = inet_aton($hostname) or die "no host: $hostname", "\n"; - $paddr = sockaddr_in($hostport, $iaddr); - $proto = getprotobyname('tcp'); - - unless (socket(Host, PF_INET, SOCK_STREAM, $proto)) - { - print "socket: $!", "\n"; - exit; - } - unless (connect(Host, $paddr)) - { - print "connect: $!", "\n"; - exit; - } - syswrite Host, $request, length($request); - #process response - process_http_response($request, $Host, 1, 1); - print "request is done\n"; - close (Host); - - return; -} + sub do_http_request($$$) + { + my ($hostname, $hostport, $request) = @_; + my ($line); + my ($iaddr, $paddr, $proto); + + $hostname =~ s/\s//g; + + $iaddr = inet_aton($hostname) or die "no host: $hostname", "\n"; + $paddr = sockaddr_in($hostport, $iaddr); + $proto = getprotobyname('tcp'); + + unless (socket(Host, PF_INET, SOCK_STREAM, $proto)) { + print "socket: $!", "\n"; + exit; + } + unless (connect(Host, $paddr)) { + print "connect: $!", "\n"; + exit; + } + syswrite Host, $request, length($request); + #process response + process_http_response($request, $Host, 1, 1); + print "request is done\n"; + close(Host); + + return; + } ########################################################### -# -# subroutine: process_http_response -# request, -# host_socket, -# save_doc_flag, -# save_http_flag -# -# options for save doc -# - save http response header in doc.http -# - save http doc in a unique file + # + # subroutine: process_http_response + # request, + # host_socket, + # save_doc_flag, + # save_http_flag + # + # options for save doc + # - save http response header in doc.http + # - save http doc in a unique file ########################################################### -sub process_http_response($$$$) -{ - my ($request, $Host, $save_doc_flag, $save_http_flag) = @_; - my ($doc_filename, $http_filename); - - my ($doc_filename) = make_doc_filename($request); - my ($doc_http_filename) = make_doc_http_filename($request); - - print $doc_filename, ' ', $doc_http_filename, "\n"; - - my ($doc_file, $doc_http_file); - ######################## - # open files for write # - ######################## - if ($save_doc_flag) - { - unless (open doc_file, ">$doc_filename") - { - print "cannot open $doc_filename for write", "\n"; - return; - } - } - if ($save_http_flag) - { - unless (open doc_http_file, ">$doc_http_filename") - { - print "cannot open $doc_http_filename for write", "\n"; - return; - } - } - ############################## - # write http header and body # - ############################## - my ($http_header) = 1; - my ($doc_body) = 0; - my ($line); - - while ($line = ) - { - if ($http_header) - { - if ($save_http_flag) - { - print doc_http_file $line; - } - if (length($line) <= 2 && $line == "\n") - { - close doc_http_file; - $http_header = 0; - $doc_body = 1; - } - } - elsif ($save_doc_flag) - { - print doc_file $line; - } - } - return; -} + sub process_http_response($$$$) + { + my ($request, $Host, $save_doc_flag, $save_http_flag) = @_; + my ($doc_filename, $http_filename); + + my ($doc_filename) = make_doc_filename($request); + my ($doc_http_filename) = make_doc_http_filename($request); + + print $doc_filename, ' ', $doc_http_filename, "\n"; + + my ($doc_file, $doc_http_file); + ######################## + # open files for write # + ######################## + if ($save_doc_flag) { + unless (open doc_file, ">$doc_filename") { + print "cannot open $doc_filename for write", "\n"; + return; + } + } + if ($save_http_flag) { + unless (open doc_http_file, ">$doc_http_filename") { + print "cannot open $doc_http_filename for write", "\n"; + return; + } + } + ############################## + # write http header and body # + ############################## + my ($http_header) = 1; + my ($doc_body) = 0; + my ($line); + + while ($line = ) { + if ($http_header) { + if ($save_http_flag) { + print doc_http_file $line; + } + if (length($line) <= 2 && $line == "\n") { + close doc_http_file; + $http_header = 0; + $doc_body = 1; + } + } elsif ($save_doc_flag) { + print doc_file $line; + } + } + return; + } ########################################################### -# -# subroutine: make_proxy_request -# request -# host_name -# host_port -# proxy_name -# proxy_port -# + # + # subroutine: make_proxy_request + # request + # host_name + # host_port + # proxy_name + # proxy_port + # ########################################################### -sub make_proxy_request($$$$$) -{ - my ($request, $host_name, $host_port, $proxy_name, $proxy_port) = @_; - my ($proxy_request) = $request; + sub make_proxy_request($$$$$) + { + my ($request, $host_name, $host_port, $proxy_name, $proxy_port) = @_; + my ($proxy_request) = $request; - my ($url_prefix) = "http:\/\/$host_name\/"; - $url_prefix =~ s/\s//g; + my ($url_prefix) = "http:\/\/$host_name\/"; + $url_prefix =~ s/\s//g; - if ($host_port != 80) - { - $url_prefix .= ":$host_port\/"; - } - $url_prefix =~ s/\s//g; + if ($host_port != 80) { + $url_prefix .= ":$host_port\/"; + } + $url_prefix =~ s/\s//g; - $proxy_request =~ s/\//$url_prefix/; + $proxy_request =~ s/\//$url_prefix/; - return ($proxy_request); -} + return ($proxy_request); + } ########################################################### -# -# subroutine: make_doc_filename request -# -# file name is: + # + # subroutine: make_doc_filename request + # + # file name is: ########################################################### -sub make_doc_filename($) -{ - my ($request) = @_; - my ($doc_filename); - my ($host_name); - - ($_, $host_name) = split (/host:/i, $request, 2); - ($host_name, $_) = split (/ /, $host_name); - #replace every . with _ - $host_name =~ s/\./_/g; - - print $request, "\n"; - print $host_name, "\n"; - - ($_, $doc_filename) = split (/ /, $request, 2); - #remove scheme://host_name if this is a proxy request -# if ($doc_filename =~ m/:\/\//) -# { -# -# } -# -# @@@@@@@@ - - ($_, $doc_filename) = split (/\//, $doc_filename, 2); - $doc_filename =~ s/\//_/g; - #remove any white spaces - $doc_filename =~ s/\s//g; - - print "doc name is: ", $doc_filename, "\n"; - - if (length($doc_filename) <= 1) - { - $doc_filename = 'default.html'; - } - - $doc_filename = $host_name . '_' . $doc_filename; - - #remove any white spaces - $doc_filename =~ s/\s//g; - - return ($doc_filename); -} + sub make_doc_filename($) + { + my ($request) = @_; + my ($doc_filename); + my ($host_name); + + ($_, $host_name) = split(/host:/i, $request, 2); + ($host_name, $_) = split(/ /, $host_name); + #replace every . with _ + $host_name =~ s/\./_/g; + + print $request, "\n"; + print $host_name, "\n"; + + ($_, $doc_filename) = split(/ /, $request, 2); + #remove scheme://host_name if this is a proxy request + # if ($doc_filename =~ m/:\/\//) + # { + # + # } + # + # @@@@@@@@ + + ($_, $doc_filename) = split(/\//, $doc_filename, 2); + $doc_filename =~ s/\//_/g; + #remove any white spaces + $doc_filename =~ s/\s//g; + + print "doc name is: ", $doc_filename, "\n"; + + if (length($doc_filename) <= 1) { + $doc_filename = 'default.html'; + } + + $doc_filename = $host_name . '_' . $doc_filename; + + #remove any white spaces + $doc_filename =~ s/\s//g; + + return ($doc_filename); + } ########################################################### -# -# subroutine: make_doc_filename request -# + # + # subroutine: make_doc_filename request + # ########################################################### -sub make_doc_http_filename($) -{ - my ($request) = @_; - my ($doc_http_filename); + sub make_doc_http_filename($) + { + my ($request) = @_; + my ($doc_http_filename); - $doc_http_filename = make_doc_filename($request); - $doc_http_filename .= '.http'; + $doc_http_filename = make_doc_filename($request); + $doc_http_filename .= '.http'; - return ($doc_http_filename); -} + return ($doc_http_filename); + } ########################################################### -# -# main entry point -# + # + # main entry point + # ########################################################### -if ($#ARGV != 1 and $#ARGV != 3) -{ - print 'no proxy : test_http_client ', "\n"; - print 'use proxy: test_http_client '; - print ' ', "\n"; - exit; -} - -if ($#ARGV == 1) -{ - my ($infile, $nusers) = @ARGV; - process_input_http_requests_file($infile, "", ""); -} -elsif ($#ARGV == 3) -{ - my ($infile, $nusers, $proxy_name, $proxy_port) = @ARGV; - process_input_http_requests_file($infile, $proxy_name, $proxy_port); -} - -print "\n"; -exit; - - - - - + if ($#ARGV != 1 and $#ARGV != 3) { + print 'no proxy : test_http_client ', "\n"; + print 'use proxy: test_http_client '; + print ' ', "\n"; + exit; + } + + if ($#ARGV == 1) { + my ($infile, $nusers) = @ARGV; + process_input_http_requests_file($infile, "", ""); + } elsif ($#ARGV == 3) { + my ($infile, $nusers, $proxy_name, $proxy_port) = @ARGV; + process_input_http_requests_file($infile, $proxy_name, $proxy_port); + } + + print "\n"; + exit; diff --git a/tools/changelog.pl b/tools/changelog.pl index ba62f093bd6..0de170e193d 100755 --- a/tools/changelog.pl +++ b/tools/changelog.pl @@ -22,105 +22,96 @@ use WWW::Curl::Easy; use JSON; -my $owner = shift; -my $repo = shift; +my $owner = shift; +my $repo = shift; my $milestone = shift; -my $auth = shift; -my $url = "https://api.github.com"; +my $auth = shift; +my $url = "https://api.github.com"; sub rate_fail { - print STDERR "You have exceeded your rate limit. Try using an auth token.\n"; - exit 2; + print STDERR "You have exceeded your rate limit. Try using an auth token.\n"; + exit 2; } sub milestone_lookup { - my $curl = shift; - my $url = shift; - my $owner = shift; - my $repo = shift; - my $milestone_title = shift; - my $endpoint = "/repos/$owner/$repo/milestones"; - - my $resp_body; - - $curl->setopt(CURLOPT_WRITEDATA, \$resp_body); - $curl->setopt(CURLOPT_URL, $url . $endpoint); - - my $retcode = $curl->perform(); - if ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200) - { - my $milestones = from_json($resp_body); - foreach my $milestone (@{ $milestones }) - { - if ($milestone->{title} eq $milestone_title) - { - return $milestone->{number}; - } + my $curl = shift; + my $url = shift; + my $owner = shift; + my $repo = shift; + my $milestone_title = shift; + my $endpoint = "/repos/$owner/$repo/milestones"; + + my $resp_body; + + $curl->setopt(CURLOPT_WRITEDATA, \$resp_body); + $curl->setopt(CURLOPT_URL, $url . $endpoint); + + my $retcode = $curl->perform(); + if ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200) { + my $milestones = from_json($resp_body); + foreach my $milestone (@{$milestones}) { + if ($milestone->{title} eq $milestone_title) { + return $milestone->{number}; + } + } + } elsif ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 403) { + rate_fail(); } - } - elsif ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 403) - { - rate_fail(); - } - undef; + undef; } sub is_merged { - my $curl = shift; - my $url = shift; - my $owner = shift; - my $repo = shift; - my $issue_id = shift; - my $endpoint = "/repos/$owner/$repo/pulls/$issue_id/merge"; - - my $resp_body; - - $curl->setopt(CURLOPT_WRITEDATA, \$resp_body); - $curl->setopt(CURLOPT_URL, $url . $endpoint); - - my $retcode = $curl->perform(); - if ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 204) { - return 1; - } - elsif ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 403) - { - rate_fail(); - } - - undef; + my $curl = shift; + my $url = shift; + my $owner = shift; + my $repo = shift; + my $issue_id = shift; + my $endpoint = "/repos/$owner/$repo/pulls/$issue_id/merge"; + + my $resp_body; + + $curl->setopt(CURLOPT_WRITEDATA, \$resp_body); + $curl->setopt(CURLOPT_URL, $url . $endpoint); + + my $retcode = $curl->perform(); + if ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 204) { + return 1; + } elsif ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 403) { + rate_fail(); + } + + undef; } sub issue_search { - my $curl = shift; - my $url = shift; - my $owner = shift; - my $repo = shift; - my $milestone_id = shift; - my $page = shift; - my $endpoint = "/repos/$owner/$repo/issues"; - - my $params = "milestone=$milestone_id&state=closed&page=$page"; - - my $resp_body; - - $curl->setopt(CURLOPT_WRITEDATA, \$resp_body); - $curl->setopt(CURLOPT_URL, $url . $endpoint . '?' . $params); - - my $retcode = $curl->perform(); - if ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200) { - return from_json($resp_body); - } - elsif ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 403) - { - rate_fail(); - } - - undef; + my $curl = shift; + my $url = shift; + my $owner = shift; + my $repo = shift; + my $milestone_id = shift; + my $page = shift; + my $endpoint = "/repos/$owner/$repo/issues"; + + my $params = "milestone=$milestone_id&state=closed&page=$page"; + + my $resp_body; + + $curl->setopt(CURLOPT_WRITEDATA, \$resp_body); + $curl->setopt(CURLOPT_URL, $url . $endpoint . '?' . $params); + + my $retcode = $curl->perform(); + if ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200) { + return from_json($resp_body); + } elsif ($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 403) { + rate_fail(); + } + + undef; } my $curl = WWW::Curl::Easy->new; @@ -128,17 +119,15 @@ sub issue_search #$curl->setopt(CURLOPT_VERBOSE, 1); $curl->setopt(CURLOPT_HTTPHEADER, ['Accept: application/vnd.github.v3+json', 'User-Agent: Awesome-Octocat-App']); -if (defined($auth)) -{ - $curl->setopt(CURLOPT_USERPWD, $auth); +if (defined($auth)) { + $curl->setopt(CURLOPT_USERPWD, $auth); } my $milestone_id = milestone_lookup($curl, $url, $owner, $repo, $milestone); -if (!defined($milestone_id)) -{ - print STDERR "Milestone not found!\n"; - exit 1; +if (!defined($milestone_id)) { + print STDERR "Milestone not found!\n"; + exit 1; } my $issues; @@ -148,39 +137,33 @@ sub issue_search print STDERR "Looking for issues from Milestone $milestone\n"; do { - print STDERR "Page $page\n"; - $issues = issue_search($curl, $url, $owner, $repo, $milestone_id, $page); - foreach my $issue (@{ $issues }) - { - if (defined($issue)) - { - print STDERR "Issue #" . $issue->{number} . " - " . $issue->{title} . " "; - - if (!exists($issue->{pull_request})) - { - print STDERR "not a PR.\n"; - next; - } - - if (!is_merged($curl, $url, $owner, $repo, $issue->{number})) - { - print STDERR "not merged.\n"; - next; - } - - print STDERR "added.\n"; - push @{ $changelog }, {number => $issue->{number}, title => $issue->{title}}; + print STDERR "Page $page\n"; + $issues = issue_search($curl, $url, $owner, $repo, $milestone_id, $page); + foreach my $issue (@{$issues}) { + if (defined($issue)) { + print STDERR "Issue #" . $issue->{number} . " - " . $issue->{title} . " "; + + if (!exists($issue->{pull_request})) { + print STDERR "not a PR.\n"; + next; + } + + if (!is_merged($curl, $url, $owner, $repo, $issue->{number})) { + print STDERR "not merged.\n"; + next; + } + + print STDERR "added.\n"; + push @{$changelog}, {number => $issue->{number}, title => $issue->{title}}; + } } - } - $page++; -} while (scalar @{ $issues }); + $page++; +} while (scalar @{$issues}); -if (defined($changelog)) -{ - print "Changes with Apache Traffic Server $milestone\n"; +if (defined($changelog)) { + print "Changes with Apache Traffic Server $milestone\n"; - foreach my $issue (sort {$a->{number} <=> $b->{number}} @{ $changelog }) - { - print " #$issue->{number} - $issue->{title}\n"; - } + foreach my $issue (sort {$a->{number} <=> $b->{number}} @{$changelog}) { + print " #$issue->{number} - $issue->{title}\n"; + } } diff --git a/tools/compare_records.pl b/tools/compare_records.pl index cf0046360b3..eb16cd4b17d 100755 --- a/tools/compare_records.pl +++ b/tools/compare_records.pl @@ -38,35 +38,39 @@ use warnings; use Getopt::Long; -my($file1, $file2, $in_files, $help); +my ($file1, $file2, $in_files, $help); my %file1_settings; my %file2_settings; my $diff_metrics; -usage() if (@ARGV < 1 or - !GetOptions( - 'f=s@' => \$in_files, - 'm' => \$diff_metrics, - 'help|?' => \$help) or - defined $help); +usage() + if ( + @ARGV < 1 + or !GetOptions( + 'f=s@' => \$in_files, + 'm' => \$diff_metrics, + 'help|?' => \$help + ) + or defined $help + ); # Input file is mandatory die "\nTwo input files must be specified to compare\n" - unless defined $in_files; + unless defined $in_files; # Print the usage sub usage { - print "Unknown option: @_\n" if (@_); - print "Provide 2 files to compare configs or metrics.\n"; - print "By default this tool will diff only configs,\n"; - print "to get diff of metrics pass -m flag\n\n"; - print "Usage: compare_records.pl -m -f -f \n"; - print " -m to diff the metrics\n"; - print " -h for help\n\n"; - print "where the files are generated with e.g.\n\n"; - print " \$ traffic_ctl config match .\n"; - exit; + print "Unknown option: @_\n" if (@_); + print "Provide 2 files to compare configs or metrics.\n"; + print "By default this tool will diff only configs,\n"; + print "to get diff of metrics pass -m flag\n\n"; + print "Usage: compare_records.pl -m -f -f \n"; + print " -m to diff the metrics\n"; + print " -h for help\n\n"; + print "where the files are generated with e.g.\n\n"; + print " \$ traffic_ctl config match .\n"; + exit; } my @file_list = @$in_files; @@ -76,89 +80,88 @@ sub usage # Open input files if (defined $in_file1) { - open $file1, $in_file1 or die "Could not open $in_file1: $!"; + open $file1, $in_file1 or die "Could not open $in_file1: $!"; } if (defined $in_file2) { - open $file2, $in_file2 or die "Could not open $in_file2: $!"; + open $file2, $in_file2 or die "Could not open $in_file2: $!"; } # Read input files while (my $setting = <$file1>) { - chomp $setting; - my($record, $value) = split(/:/, $setting); - if (defined $diff_metrics) { - # Obtain only metrics, excluding configs - if ($record !~ /proxy.config/) { - $file1_settings{$record} = $value; - } - } else { - # Obtain only configs - if ($record =~ /proxy.config/) { - $file1_settings{$record} = $value; + chomp $setting; + my ($record, $value) = split(/:/, $setting); + if (defined $diff_metrics) { + # Obtain only metrics, excluding configs + if ($record !~ /proxy.config/) { + $file1_settings{$record} = $value; + } + } else { + # Obtain only configs + if ($record =~ /proxy.config/) { + $file1_settings{$record} = $value; + } } - } } close $file1; while (my $setting = <$file2>) { - chomp $setting; - my($record, $value) = split(/:/, $setting); - if (defined $diff_metrics) { - # Obtain only metrics, excluding configs - if ($record !~ /proxy.config/) { - $file2_settings{$record} = $value; - } - } else { - # Obtain only configs - if ($record =~ /proxy.config/) { - $file2_settings{$record} = $value; + chomp $setting; + my ($record, $value) = split(/:/, $setting); + if (defined $diff_metrics) { + # Obtain only metrics, excluding configs + if ($record !~ /proxy.config/) { + $file2_settings{$record} = $value; + } + } else { + # Obtain only configs + if ($record =~ /proxy.config/) { + $file2_settings{$record} = $value; + } } - } } close $file2; # Subroutine to compare configs/metrics and obtain common and difference between them sub compare_configs_or_metrics { - my($records1, $records2, $file) = @_; - my %common_settings; - my %diff_settings; - my %settings1 = %$records1; - my %settings2 = %$records2; - - foreach my $record(sort keys %settings1) { - if ($settings2{$record}) { - $common_settings{$record} = $settings1{$record}; - } else { - $diff_settings{$record} = $settings1{$record}; + my ($records1, $records2, $file) = @_; + my %common_settings; + my %diff_settings; + my %settings1 = %$records1; + my %settings2 = %$records2; + + foreach my $record (sort keys %settings1) { + if ($settings2{$record}) { + $common_settings{$record} = $settings1{$record}; + } else { + $diff_settings{$record} = $settings1{$record}; + } } - } - print "####################################################################################\n"; - print "Configs/metrics found only in $file\n"; - print "####################################################################################\n"; - foreach my $key(sort keys %diff_settings) - { - print "$key\n"; - } - return (\%common_settings); + print "####################################################################################\n"; + print "Configs/metrics found only in $file\n"; + print "####################################################################################\n"; + foreach my $key (sort keys %diff_settings) { + print "$key\n"; + } + return (\%common_settings); } # Subroutine to obtain changes in default values among common configs/metrics sub compare_default_values { - my($records1, $records2) = @_; - my %settings1 = %$records1; - my %settings2 = %$records2; - - foreach my $record(sort keys %settings1) { - if (defined $settings1{$record} && $settings2{$record}) { - if ($settings1{$record} ne $settings2{$record}) { - # Values doesn't match - print "$record default value changed from $settings1{$record} -> $settings2{$record}\n"; - } + my ($records1, $records2) = @_; + my %settings1 = %$records1; + my %settings2 = %$records2; + + foreach my $record (sort keys %settings1) { + if (defined $settings1{$record} && $settings2{$record}) { + if ($settings1{$record} ne $settings2{$record}) { + # Values doesn't match + print "$record default value changed from $settings1{$record} -> $settings2{$record}\n"; + } + } } - } } # Obtain common configs/metrics between two files @@ -171,9 +174,8 @@ sub compare_default_values print "####################################################################################\n"; print "Common configs/metrics between $in_file1 and $in_file2\n"; print "####################################################################################\n"; -foreach my $key(sort keys %common2_settings) -{ - print "$key\n"; +foreach my $key (sort keys %common2_settings) { + print "$key\n"; } # Compare common configs/metrics and obtain changes in default values diff --git a/tools/compare_servers.pl b/tools/compare_servers.pl index 7f1bcb86bb3..4c485da6c24 100755 --- a/tools/compare_servers.pl +++ b/tools/compare_servers.pl @@ -28,218 +28,232 @@ my $verbose = 0; #---------------------------------------------------------------------------- -sub usage() { - print STDERR "USAGE: compare_hosts.pl --verbose level --host1 testing_host --host2 valid_host --file url_file\n\n"; - print STDERR "\t--host1 The host running the newest version\n"; - print STDERR "\t--host2 The host running the older version\n"; - print STDERR "\t--file A file that contains a list of URLs\n"; - print STDERR "\t--verbose verbose level 1-3, 1 is the least verbose\n\n"; - print STDERR "Example:\n"; - print STDERR "\tcompare_hosts.pl --host1 new_ats --host2 old_ats --file top_1000_urls\n"; - exit 1; +sub usage() +{ + print STDERR "USAGE: compare_hosts.pl --verbose level --host1 testing_host --host2 valid_host --file url_file\n\n"; + print STDERR "\t--host1 The host running the newest version\n"; + print STDERR "\t--host2 The host running the older version\n"; + print STDERR "\t--file A file that contains a list of URLs\n"; + print STDERR "\t--verbose verbose level 1-3, 1 is the least verbose\n\n"; + print STDERR "Example:\n"; + print STDERR "\tcompare_hosts.pl --host1 new_ats --host2 old_ats --file top_1000_urls\n"; + exit 1; } #---------------------------------------------------------------------------- -sub compareHeaderNames($$) { - my($response1, $response2) = @_; +sub compareHeaderNames($$) +{ + my ($response1, $response2) = @_; - my @names1 = $response1->header_field_names; - my @names2 = $response2->header_field_names; + my @names1 = $response1->header_field_names; + my @names2 = $response2->header_field_names; - my %hash2; - $hash2{$_} = 1 for (@names2); - my %hash1; - $hash1{$_} = 1 for (@names1); + my %hash2; + $hash2{$_} = 1 for (@names2); + my %hash1; + $hash1{$_} = 1 for (@names1); - my $return_val = 0; # header names match + my $return_val = 0; # header names match - foreach my $name (@names1) { - if (!defined $hash2{$name}) { - print "\t\t- $name header not found on host2\n" if $verbose >= 2; - $return_val = 1; + foreach my $name (@names1) { + if (!defined $hash2{$name}) { + print "\t\t- $name header not found on host2\n" if $verbose >= 2; + $return_val = 1; + } } - } - foreach my $name (@names2) { - if (!defined $hash1{$name}) { - print "\t\t- $name header not found on host1\n" if $verbose >= 2; - $return_val = 1; + foreach my $name (@names2) { + if (!defined $hash1{$name}) { + print "\t\t- $name header not found on host1\n" if $verbose >= 2; + $return_val = 1; + } } - } - return $return_val; + return $return_val; } #---------------------------------------------------------------------------- -sub compareHeaderValues($$) { - my($response1, $response2) = @_; +sub compareHeaderValues($$) +{ + my ($response1, $response2) = @_; - my @test_headers = qw(ETag Cache-Control Connection Accept-Ranges Server Content-Type Access-Control-Allow-Methods Access-Control-Allow-Origin Strict-Transport-Security); - my $return_val = 0; # header valuse match + my @test_headers = + qw(ETag Cache-Control Connection Accept-Ranges Server Content-Type Access-Control-Allow-Methods Access-Control-Allow-Origin Strict-Transport-Security); + my $return_val = 0; # header valuse match - if ($verbose >= 3) { - foreach my $field ($response1->header_field_names) { - print "\t\t\t~ " . $field . ": " . $response1->header($field) . "\n"; - } + if ($verbose >= 3) { + foreach my $field ($response1->header_field_names) { + print "\t\t\t~ " . $field . ": " . $response1->header($field) . "\n"; + } - print "\t\tHost2: \n"; + print "\t\tHost2: \n"; - foreach my $field ($response2->header_field_names) { - print "\t\t\t~ " . $field . ": " . $response2->header($field) . "\n"; + foreach my $field ($response2->header_field_names) { + print "\t\t\t~ " . $field . ": " . $response2->header($field) . "\n"; + } } - } - - # Test specific headers that are defined above - foreach my $field (@test_headers) { - my $value1 = $response1->header($field); - my $value2 = $response2->header($field); - - if (defined $value1 && defined $value2) { - if ($value1 ne $value2) { - print "\t\t- $field: $value1 ne $value2\n" if $verbose; - print "\t\t\t - Via host1: " . $response1->header('Via') . " host2: " . $response2->header('Via') . "\n" if $verbose; - print "\t\t\t - Last-Modified host1: " . $response1->header('Last-Modified') . " host2: " . $response2->header('Last-Modified') . "\n" if $verbose; - if (defined $response2->header('Content-Encoding')) { - print "\t\t\t - Content-Encoding host1: " . $response1->header('Content-Encoding') . " host2: " . $response2->header('Content-Encoding') . "\n"; - } else { - print "\t\t\t - Content-Encoding host1: " . $response1->header('Content-Encoding') . " host2: ''\n"; + + # Test specific headers that are defined above + foreach my $field (@test_headers) { + my $value1 = $response1->header($field); + my $value2 = $response2->header($field); + + if (defined $value1 && defined $value2) { + if ($value1 ne $value2) { + print "\t\t- $field: $value1 ne $value2\n" if $verbose; + print "\t\t\t - Via host1: " . $response1->header('Via') . " host2: " . $response2->header('Via') . "\n" + if $verbose; + print "\t\t\t - Last-Modified host1: " + . $response1->header('Last-Modified') + . " host2: " + . $response2->header('Last-Modified') . "\n" + if $verbose; + if (defined $response2->header('Content-Encoding')) { + print "\t\t\t - Content-Encoding host1: " + . $response1->header('Content-Encoding') + . " host2: " + . $response2->header('Content-Encoding') . "\n"; + } else { + print "\t\t\t - Content-Encoding host1: " . $response1->header('Content-Encoding') . " host2: ''\n"; + } + $return_val = 1; + } else { + print "\t\t- $field: $value1 eq $value2\n" if $verbose >= 2; + } } - $return_val = 1; - } else { - print "\t\t- $field: $value1 eq $value2\n" if $verbose >= 2; - } } - } - return $return_val; + return $return_val; } #---------------------------------------------------------------------------- { - my %stats; - - $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = '0'; - my($host1, $host2, $file); - GetOptions ("host1=s" => \$host1, - "host2=s" => \$host2, - "file=s" => \$file, - "verbose=f" => \$verbose) || die $!; - - usage() if (! defined $host1 || ! defined $host2 || ! defined $file); - - my $count = 0; - my $status_error = 0; - my $sha_error = 0; - my $header_names_mismatch = 0; - my $header_values_mismatch = 0; - - my $host1_addr = inet_ntoa(inet_aton($host1)); - my $host2_addr = inet_ntoa(inet_aton($host2)); - - print "Testing with host1: $host1 ($host1_addr) - host2: $host2 ($host2_addr)\n"; - print '-' x 78, "\n"; - - open(FILE, $file) || die $!; - - # Create a user agent object - my $ua1 = LWP::UserAgent->new(keep_alive => 100); - $ua1->agent("MyApp/0.1 "); - - # Create a user agent object - my $ua2 = LWP::UserAgent->new(keep_alive => 100); - $ua2->agent("MyApp/0.1 "); - - while (my $url = ) { - next if ($url =~ m|hc.l.yimg.com|); - chomp $url; - my $exit = 0; - - if ($url =~ m|(https?)://([^/]+)(.+)|) { - - my $scheme = $1; - my $host = $2; - my $path = $3; - - $count++; - print "Test $count - URL: $url\n"; - - my $port = 80; - $port = 443 if $scheme eq 'https'; - - my $request1 = HTTP::Request->new(GET => "${scheme}://${host1_addr}${path}"); - $request1->header('Host' => $host); - my $response1 = $ua1->request($request1); - - my $request2 = HTTP::Request->new(GET => "${scheme}://${host2_addr}${path}"); - $request2->header('Host' => $host); - $request2->header('Accept-Encoding' => 'deflate'); - my $response2 = $ua2->request($request2); - - print "\tStatus code for host1: " . $response1->code . " - host2: " . $response2->code . "\n" if $verbose; - - my $sha1 = Digest::SHA1->new; - $sha1->add($response1->content); - my $digest1 = $sha1->hexdigest; - open(FILE1, "> /tmp/tmp1"); - open(FILE2, "> /tmp/tmp2"); - print FILE1 $response1->content; - print FILE2 $response2->content; - close FILE1; - close FILE2; - #print $response1->content, "\n"; # for internal debugging - #print $response2->content, "\n"; # for internal debugging - - my $sha2 = Digest::SHA1->new; - $sha2->add($response2->content); - my $digest2 = $sha2->hexdigest; - - print "\tSHA hash for host1: $digest1 - host2: $digest2\n" if $verbose; - - # Build up stats - if ($response1->status_line eq $response2->status_line) { - - # Do the hashes - if ($digest1 eq $digest2) { - $stats{stat_line_match}->{$response1->code}->{sha_match}++; - print "\tResponse code: " . $response1->code . " - Status lines and SHA1 of response bodies match\n"; - } else { - $stats{stat_line_match}->{$response1->code}->{sha_nomatch}++; - print "\tResponse code: " . $response1->code . " - Status lines match SHA1 doesn't match\n"; - $sha_error++; - #$exit = 1 if $response1->code == 200; # for internal debugging - } - - # Compare the header field names - if (compareHeaderNames($response1, $response2) == 0) { - $stats{stat_line_match}->{$response1->code}->{field_names_match}++; - } else { - $stats{stat_line_match}->{$response1->code}->{field_names_nomatch}++; - $header_names_mismatch++; + my %stats; + + $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = '0'; + my ($host1, $host2, $file); + GetOptions( + "host1=s" => \$host1, + "host2=s" => \$host2, + "file=s" => \$file, + "verbose=f" => \$verbose + ) || die $!; + + usage() if (!defined $host1 || !defined $host2 || !defined $file); + + my $count = 0; + my $status_error = 0; + my $sha_error = 0; + my $header_names_mismatch = 0; + my $header_values_mismatch = 0; + + my $host1_addr = inet_ntoa(inet_aton($host1)); + my $host2_addr = inet_ntoa(inet_aton($host2)); + + print "Testing with host1: $host1 ($host1_addr) - host2: $host2 ($host2_addr)\n"; + print '-' x 78, "\n"; + + open(FILE, $file) || die $!; + + # Create a user agent object + my $ua1 = LWP::UserAgent->new(keep_alive => 100); + $ua1->agent("MyApp/0.1 "); + + # Create a user agent object + my $ua2 = LWP::UserAgent->new(keep_alive => 100); + $ua2->agent("MyApp/0.1 "); + + while (my $url = ) { + next if ($url =~ m|hc.l.yimg.com|); + chomp $url; + my $exit = 0; + + if ($url =~ m|(https?)://([^/]+)(.+)|) { + + my $scheme = $1; + my $host = $2; + my $path = $3; + + $count++; + print "Test $count - URL: $url\n"; + + my $port = 80; + $port = 443 if $scheme eq 'https'; + + my $request1 = HTTP::Request->new(GET => "${scheme}://${host1_addr}${path}"); + $request1->header('Host' => $host); + my $response1 = $ua1->request($request1); + + my $request2 = HTTP::Request->new(GET => "${scheme}://${host2_addr}${path}"); + $request2->header('Host' => $host); + $request2->header('Accept-Encoding' => 'deflate'); + my $response2 = $ua2->request($request2); + + print "\tStatus code for host1: " . $response1->code . " - host2: " . $response2->code . "\n" if $verbose; + + my $sha1 = Digest::SHA1->new; + $sha1->add($response1->content); + my $digest1 = $sha1->hexdigest; + open(FILE1, "> /tmp/tmp1"); + open(FILE2, "> /tmp/tmp2"); + print FILE1 $response1->content; + print FILE2 $response2->content; + close FILE1; + close FILE2; + #print $response1->content, "\n"; # for internal debugging + #print $response2->content, "\n"; # for internal debugging + + my $sha2 = Digest::SHA1->new; + $sha2->add($response2->content); + my $digest2 = $sha2->hexdigest; + + print "\tSHA hash for host1: $digest1 - host2: $digest2\n" if $verbose; + + # Build up stats + if ($response1->status_line eq $response2->status_line) { + + # Do the hashes + if ($digest1 eq $digest2) { + $stats{stat_line_match}->{$response1->code}->{sha_match}++; + print "\tResponse code: " . $response1->code . " - Status lines and SHA1 of response bodies match\n"; + } else { + $stats{stat_line_match}->{$response1->code}->{sha_nomatch}++; + print "\tResponse code: " . $response1->code . " - Status lines match SHA1 doesn't match\n"; + $sha_error++; + #$exit = 1 if $response1->code == 200; # for internal debugging + } + + # Compare the header field names + if (compareHeaderNames($response1, $response2) == 0) { + $stats{stat_line_match}->{$response1->code}->{field_names_match}++; + } else { + $stats{stat_line_match}->{$response1->code}->{field_names_nomatch}++; + $header_names_mismatch++; + } + + # Compare the values of the header fields + if (compareHeaderValues($response1, $response2) == 0) { + $stats{stat_line_match}->{$response1->code}->{field_values_match}++; + } else { + $stats{stat_line_match}->{$response1->code}->{field_values_nomatch}++; + $header_values_mismatch++; + } + } else { + $status_error++; + $stats{stat_line_nomatch}++; + print "\tERROR: status lines don't match\n"; + } + + last if $exit; } - - # Compare the values of the header fields - if (compareHeaderValues($response1, $response2) == 0) { - $stats{stat_line_match}->{$response1->code}->{field_values_match}++; - } else { - $stats{stat_line_match}->{$response1->code}->{field_values_nomatch}++; - $header_values_mismatch++; - } - } else { - $status_error++; - $stats{stat_line_nomatch}++; - print "\tERROR: status lines don't match\n"; - } - - last if $exit; } - } - - print '-' x 78, "\n"; - print "SUMMARY:\n"; - print "URLs tested: $count\n"; - print "Status line mismatches: $status_error\n"; - print "SHA1 mismatches: $sha_error\n"; - print "Responses with header names mismatches: $header_names_mismatch\n"; - print "Responses with header values mismatches: $header_values_mismatch\n"; - print Dumper \%stats if $verbose; + + print '-' x 78, "\n"; + print "SUMMARY:\n"; + print "URLs tested: $count\n"; + print "Status line mismatches: $status_error\n"; + print "SHA1 mismatches: $sha_error\n"; + print "Responses with header names mismatches: $header_names_mismatch\n"; + print "Responses with header values mismatches: $header_values_mismatch\n"; + print Dumper \%stats if $verbose; } diff --git a/tools/freelist_diff.pl b/tools/freelist_diff.pl index 8f15a93d970..4e9e92d68e6 100755 --- a/tools/freelist_diff.pl +++ b/tools/freelist_diff.pl @@ -16,21 +16,24 @@ # See the License for the specific language governing permissions and # limitations under the License. -sub usage { +sub usage +{ print "Usage: freelist_diff.pl dump1.txt dump2.txt\n"; } -sub int_meg { +sub int_meg +{ my $bytes = shift; - return $bytes / (1024*1024); + return $bytes / (1024 * 1024); } -sub load_file { +sub load_file +{ my $file = shift; my %data; open(DATA, $file) || return undef; - while() { + while () { my @items = split; chomp @items; @@ -49,11 +52,13 @@ sub load_file { while (my ($key, $value) = each(%{$data1})) { # before alloc [0], after alloc [1], before in-use [2], after in-use [3] - $diff{$key} = [ $value->[0], $data2->{$key}->[0], $value->[1], $data2->{$key}->[1], - # diff alloc [4], diff in-use [5] - $data2->{$key}->[0] - $value->[0], $data2->{$key}->[1] - $value->[1], - # type size [6] - $value->[2] ]; + $diff{$key} = [ + $value->[0], $data2->{$key}->[0], $value->[1], $data2->{$key}->[1], + # diff alloc [4], diff in-use [5] + $data2->{$key}->[0] - $value->[0], $data2->{$key}->[1] - $value->[1], + # type size [6] + $value->[2] + ]; } print "Sorted by in-use growth\n"; diff --git a/tools/http_load/merge_stats.pl b/tools/http_load/merge_stats.pl index 49e93a4f709..db406004907 100644 --- a/tools/http_load/merge_stats.pl +++ b/tools/http_load/merge_stats.pl @@ -20,54 +20,57 @@ # See the License for the specific language governing permissions and # limitations under the License. -my $runs = 0; -my $fetches = 0; -my $conns = 0; -my $parallel = 0; -my $bytes = 0; -my $seconds = 0; -my $mean_bytes = 0; -my $fetches_sec = 0.0; -my $bytes_sec = 0.0; -my %msecs_connect = ( "mean" => 0.0, - "max" => 0.0, - "min" => 0.0 ); -my %msecs_response = ( "mean" => 0.0, - "max" => 0.0, - "min" => 0.0 ); - +my $runs = 0; +my $fetches = 0; +my $conns = 0; +my $parallel = 0; +my $bytes = 0; +my $seconds = 0; +my $mean_bytes = 0; +my $fetches_sec = 0.0; +my $bytes_sec = 0.0; +my %msecs_connect = ( + "mean" => 0.0, + "max" => 0.0, + "min" => 0.0 +); +my %msecs_response = ( + "mean" => 0.0, + "max" => 0.0, + "min" => 0.0 +); while (<>) { - my @c = split(); - if (/fetches on/) { - $fetches += $c[0]; - $conns += $c[3]; - $parallel += $c[5]; - $bytes += $c[8]; - $seconds += $c[11]; - $runs++; - } elsif (/mean bytes/) { - $mean_bytes += $c[0]; - } elsif (/fetches\/sec/) { - $fetches_sec += $c[0]; - $bytes_sec += $c[2]; - } elsif (/msecs\/connect/) { - $msecs_connect{"mean"} += $c[1]; - $msecs_connect{"max"} += $c[3]; - $msecs_connect{"min"} += $c[5]; - } elsif (/msecs\/first/) { - $msecs_response{"mean"} += $c[1]; - $msecs_response{"max"} += $c[3]; - $msecs_response{"min"} += $c[5]; - } + my @c = split(); + if (/fetches on/) { + $fetches += $c[0]; + $conns += $c[3]; + $parallel += $c[5]; + $bytes += $c[8]; + $seconds += $c[11]; + $runs++; + } elsif (/mean bytes/) { + $mean_bytes += $c[0]; + } elsif (/fetches\/sec/) { + $fetches_sec += $c[0]; + $bytes_sec += $c[2]; + } elsif (/msecs\/connect/) { + $msecs_connect{"mean"} += $c[1]; + $msecs_connect{"max"} += $c[3]; + $msecs_connect{"min"} += $c[5]; + } elsif (/msecs\/first/) { + $msecs_response{"mean"} += $c[1]; + $msecs_response{"max"} += $c[3]; + $msecs_response{"min"} += $c[5]; + } } print "Total runs: ", $runs, "\n"; printf "%d fetches on %d conns, %d max parallell, %.5e bytes in %d seconds\n", $fetches, $conns, $parallel, $bytes, $seconds / $runs; -print $mean_bytes/$runs, " mean bytes/fetch\n"; -printf "%.2f fetches/sec, %.5e bytes/sec\n", $fetches_sec, $bytes_sec; -print "msecs/connect: ", $msecs_connect{"mean"}/$runs, " mean, ", - $msecs_connect{"max"}/$runs, " max, ", $msecs_connect{"min"}/$runs, " min\n"; -print "msecs/first-response: ", $msecs_response{"mean"}/$runs, " mean, ", - $msecs_response{"max"}/$runs, " max, ", $msecs_response{"min"}/$runs, " min\n"; +print $mean_bytes/ $runs, " mean bytes/fetch\n"; +printf "%.2f fetches/sec, %.5e bytes/sec\n", $fetches_sec, $bytes_sec; +print "msecs/connect: ", $msecs_connect{"mean"} / $runs, " mean, ", + $msecs_connect{"max"} / $runs, " max, ", $msecs_connect{"min"} / $runs, " min\n"; +print "msecs/first-response: ", $msecs_response{"mean"} / $runs, " mean, ", + $msecs_response{"max"} / $runs, " max, ", $msecs_response{"min"} / $runs, " min\n"; diff --git a/tools/slow_log_report.pl b/tools/slow_log_report.pl index 9207b5906af..81fb52d47da 100755 --- a/tools/slow_log_report.pl +++ b/tools/slow_log_report.pl @@ -21,62 +21,72 @@ use warnings; #use Data::Dumper; -sub addStat($$$) { - my($stats, $key, $value) = @_; - #print "$key $value\n"; - $stats->{$key}->{total} = 0 if (! defined $stats->{$key}->{total}); - $stats->{$key}->{count} = 0 if (! defined $stats->{$key}->{count}); - return if (! ($value =~ m|^-?\d+\.?\d*$|)); - #print "$key\n"; - $stats->{$key}->{total} += $value if $value >= 0; - $stats->{$key}->{count}++ if $value >= 0; - push(@{$stats->{$key}->{values}}, $value) if $value >= 0; +sub addStat($$$) +{ + my ($stats, $key, $value) = @_; + #print "$key $value\n"; + $stats->{$key}->{total} = 0 if (!defined $stats->{$key}->{total}); + $stats->{$key}->{count} = 0 if (!defined $stats->{$key}->{count}); + return if (!($value =~ m|^-?\d+\.?\d*$|)); + #print "$key\n"; + $stats->{$key}->{total} += $value if $value >= 0; + $stats->{$key}->{count}++ if $value >= 0; + push(@{$stats->{$key}->{values}}, $value) if $value >= 0; } -sub displayStat($) { - my($stats) = @_; +sub displayStat($) +{ + my ($stats) = @_; + + printf("%25s %10s %10s %10s %10s %10s %10s %10s %10s\n", + 'key', 'total', 'count', 'mean', 'median', '95th', '99th', 'min', 'max'); + foreach my $key ( + 'ua_begin', 'ua_first_read', 'ua_read_header_done', 'cache_open_read_begin', + 'cache_open_read_end', 'dns_lookup_begin', 'dns_lookup_end', 'server_connect', + 'server_connect_end', 'server_first_read', 'server_read_header_done', 'server_close', + 'ua_close', 'sm_finish' + ) + { - printf("%25s %10s %10s %10s %10s %10s %10s %10s %10s\n", 'key', 'total', 'count', 'mean', 'median', '95th', '99th', 'min', 'max'); - foreach my $key ('ua_begin', 'ua_first_read', 'ua_read_header_done', 'cache_open_read_begin', 'cache_open_read_end', 'dns_lookup_begin', 'dns_lookup_end', 'server_connect', 'server_connect_end', 'server_first_read', 'server_read_header_done', 'server_close', 'ua_close', 'sm_finish') { + my $count = $stats->{$key}->{count}; + my $total = $stats->{$key}->{total}; + if (!defined $stats->{$key}->{values}) { + next; + #print "$key\n"; + #die $key; + } + my @sorted = sort {$a <=> $b} @{$stats->{$key}->{values}}; + my $median = $sorted[int($count / 2)]; + my $p95th = $sorted[int($count * .95)]; + my $p99th = $sorted[int($count * .99)]; + my $min = $sorted[0]; + my $max = $sorted[$count - 1]; + my $mean = 0; + $mean = $total / $count if $count > 0; - my $count = $stats->{$key}->{count}; - my $total = $stats->{$key}->{total}; - if (!defined $stats->{$key}->{values}) { - next; - #print "$key\n"; - #die $key; + printf("%25s %10.2f %10.2f %10.2f %10.2f %10.2f %10.2f %10.2f %10.2f\n", + $key, $total, $count, $mean, $median, $p95th, $p99th, $min, $max); } - my @sorted = sort {$a <=> $b} @{$stats->{$key}->{values}}; - my $median = $sorted[int($count/2)]; - my $p95th = $sorted[int($count * .95)]; - my $p99th = $sorted[int($count * .99)]; - my $min = $sorted[0]; - my $max = $sorted[$count - 1]; - my $mean = 0; - $mean = $total / $count if $count > 0; - - printf("%25s %10.2f %10.2f %10.2f %10.2f %10.2f %10.2f %10.2f %10.2f\n", $key, $total, $count, $mean, $median, $p95th, $p99th, $min, $max); - } - print "NOTE: Times are in seconds\n"; + print "NOTE: Times are in seconds\n"; } { - my %stats; + my %stats; - while (<>) { - chomp; - s/unique id/unique_id/; - s/server state/server_state/; - s/client state/client_state/; - if (m|Slow Request: .+ (ua_begin: .+)|) { - my %data = split(/: | /, $1); - foreach my $key (keys %data) { - next if (!defined $data{$key}); - #print "$key $data{$key}\n"; - addStat(\%stats, $key, $data{$key}); - } + while (<>) { + chomp; + s/unique id/unique_id/; + s/server state/server_state/; + s/client state/client_state/; + if (m|Slow Request: .+ (ua_begin: .+)|) { + my %data = split(/: | /, $1); + foreach my $key (keys %data) { + next if (!defined $data{$key}); + #print "$key $data{$key}\n"; + addStat(\%stats, $key, $data{$key}); + } + } } - } - displayStat(\%stats); + displayStat(\%stats); } diff --git a/tools/traffic_via.pl b/tools/traffic_via.pl index 6eee2a6cb13..e5a0f297cac 100755 --- a/tools/traffic_via.pl +++ b/tools/traffic_via.pl @@ -25,9 +25,9 @@ # 1. Pass Via Header with -s option \n"; # traffic_via [-s viaheader]"; # or -# 2. Pipe curl output +# 2. Pipe curl output # curl -v -H "X-Debug: Via" http://ats_server:port 2>&1| ./traffic_via.pl -# +# use strict; use warnings; @@ -40,8 +40,7 @@ #Proxy request header flags and titles my @proxy_header_array = ( { - "Request headers received from client:", - { + "Request headers received from client:", { 'I' => "If Modified Since (IMS)", 'C' => "cookie", 'E' => "error in request", @@ -49,115 +48,93 @@ 'N' => "no-cache", ' ' => "unknown?", }, - }, - { - "Result of Traffic Server cache lookup for URL:", - { - 'A' => "in cache, not acceptable (a cache \"MISS\")", - 'H' => "in cache, fresh (a cache \"HIT\")", - 'S' => "in cache, stale (a cache \"MISS\")", - 'R' => "in cache, fresh Ram hit (a cache \"HIT\")", - 'M' => "miss (a cache \"MISS\")", - ' ' => "unknown?", + }, { + "Result of Traffic Server cache lookup for URL:", { + 'A' => "in cache, not acceptable (a cache \"MISS\")", + 'H' => "in cache, fresh (a cache \"HIT\")", + 'S' => "in cache, stale (a cache \"MISS\")", + 'R' => "in cache, fresh Ram hit (a cache \"HIT\")", + 'M' => "miss (a cache \"MISS\")", + ' ' => "unknown?", }, - }, - { - "Response information received from origin server:", - { - 'E' => "error in response", - ' ' => "no server connection needed", - 'S' => "served", - 'N'=> "not-modified", + }, { + "Response information received from origin server:", { + 'E' => "error in response", + ' ' => "no server connection needed", + 'S' => "served", + 'N' => "not-modified", } - }, - { - "Result of document write-to-cache:", - { - 'U' => "updated old cache copy", - 'D' => "cached copy deleted", - 'W' => "written into cache (new copy)", - ' ' => "no cache write performed", + }, { + "Result of document write-to-cache:", { + 'U' => "updated old cache copy", + 'D' => "cached copy deleted", + 'W' => "written into cache (new copy)", + ' ' => "no cache write performed", }, - }, - { - "Proxy operation result:", - { - 'R' => "origin server revalidated", - ' ' => "unknown?", - 'S' => "served", - 'N' => "not-modified", + }, { + "Proxy operation result:", { + 'R' => "origin server revalidated", + ' ' => "unknown?", + 'S' => "served", + 'N' => "not-modified", }, - }, - { - "Error codes (if any):", - { - 'A' => "authorization failure", - 'H' => "header syntax unacceptable", - 'C' => "connection to server failed", - 'T' => "connection timed out", - 'S' => "server related error", - 'D' => "dns failure", - 'N' => "no error", - 'F' => "request forbidden", + }, { + "Error codes (if any):", { + 'A' => "authorization failure", + 'H' => "header syntax unacceptable", + 'C' => "connection to server failed", + 'T' => "connection timed out", + 'S' => "server related error", + 'D' => "dns failure", + 'N' => "no error", + 'F' => "request forbidden", }, - }, - { - "Tunnel info:", - { - ' ' => "no tunneling", - 'U' => "tunneling because of url (url suggests dynamic content)", - 'M' => "tunneling due to a method (e.g. CONNECT)", - 'O' => "tunneling because cache is turned off", - 'F' => "tunneling due to a header field (such as presence of If-Range header)", + }, { + "Tunnel info:", { + ' ' => "no tunneling", + 'U' => "tunneling because of url (url suggests dynamic content)", + 'M' => "tunneling due to a method (e.g. CONNECT)", + 'O' => "tunneling because cache is turned off", + 'F' => "tunneling due to a header field (such as presence of If-Range header)", }, - }, - { - "Cache type:", - { - 'I' => "icp", - ' ' => "cache miss or no cache lookup", - 'C' => "cache", + }, { + "Cache type:", { + 'I' => "icp", + ' ' => "cache miss or no cache lookup", + 'C' => "cache", }, - }, - { - "Cache lookup result:", - { - ' ' => "no cache lookup", - 'S' => "cache hit, but expired", - 'U' => "cache hit, but client forces revalidate (e.g. Pragma: no-cache)", - 'D' => "cache hit, but method forces revalidated (e.g. ftp, not anonymous)", - 'I' => "conditional miss (client sent conditional, fresh in cache, returned 412)", - 'H' => "cache hit", - 'M' => "cache miss (url not in cache)", - 'C' => "cache hit, but config forces revalidate", - 'N' => "conditional hit (client sent conditional, doc fresh in cache, returned 304)", + }, { + "Cache lookup result:", { + ' ' => "no cache lookup", + 'S' => "cache hit, but expired", + 'U' => "cache hit, but client forces revalidate (e.g. Pragma: no-cache)", + 'D' => "cache hit, but method forces revalidated (e.g. ftp, not anonymous)", + 'I' => "conditional miss (client sent conditional, fresh in cache, returned 412)", + 'H' => "cache hit", + 'M' => "cache miss (url not in cache)", + 'C' => "cache hit, but config forces revalidate", + 'N' => "conditional hit (client sent conditional, doc fresh in cache, returned 304)", }, - }, - { - "ICP status:", - { - ' ' => "no icp", - 'S' => "connection opened successfully", - 'F' => "connection open failed", + }, { + "ICP status:", { + ' ' => "no icp", + 'S' => "connection opened successfully", + 'F' => "connection open failed", }, - }, - { - "Parent proxy connection status:", - { - ' ' => "no parent proxy", - 'S' => "connection opened successfully", - 'F' => "connection open failed", + }, { + "Parent proxy connection status:", { + ' ' => "no parent proxy", + 'S' => "connection opened successfully", + 'F' => "connection open failed", }, - - }, - { - "Origin server connection status:", - { - ' ' => "no server connection", - 'S' => "connection opened successfully", - 'F' => "connection open failed", + + }, { + "Origin server connection status:", { + ' ' => "no server connection", + 'S' => "connection opened successfully", + 'F' => "connection open failed", }, - }, + }, ); ##Print script usage @@ -181,17 +158,22 @@ sub usage #Pattern matching for Via if ($element =~ /Via:(.*)\[(.*)\]/) { #Search and grep via header - $via_string = $2; + $via_string = $2; chomp($via_string); print "Via Header is [$via_string]"; decode_via_header($via_string); } } } else { - usage() if (!GetOptions('s=s' => \$via_header, - 'help|?' => \$help) or - defined $help); - + usage() + if ( + !GetOptions( + 's=s' => \$via_header, + 'help|?' => \$help + ) + or defined $help + ); + if (defined $via_header) { #if passed through commandline dashed argument print "Via Header is [$via_header]"; @@ -201,16 +183,17 @@ sub usage } #Subroutine to decode via header -sub decode_via_header { - my($header) = @_; +sub decode_via_header +{ + my ($header) = @_; my $hdrLength; my $newHeader; #Check via header syntax - if ($header =~ /([a-zA-Z: ]+)/) { + if ($header =~ /([a-zA-Z: ]+)/) { #Get via header length $hdrLength = length($header); - + # Valid Via header length is 24 or 6. # When Via header length is 24, it will have both proxy request header result and operational results. if ($hdrLength == 24) { @@ -220,7 +203,7 @@ sub decode_via_header { $newHeader = $header; } elsif ($hdrLength == 5) { # When Via header length is 5, it might be missing last field. Fill it and decode header. - my $newHeader = "$header"." "; + my $newHeader = "$header" . " "; } else { # Invalid header size, come out. print "\nInvalid VIA header. VIA header length should be 6 or 24 characters\n"; @@ -228,49 +211,50 @@ sub decode_via_header { } convert_header_to_array($newHeader); } - - + } -sub convert_header_to_array { +sub convert_header_to_array +{ my ($viaHeader) = @_; my @ResultArray; #Convert string header into character array while ($viaHeader =~ /(.)/g) { - #Only capital letters indicate flags - if ($1 !~ m/[a-z]+/) { - push(@ResultArray, $1); - } + #Only capital letters indicate flags + if ($1 !~ m/[a-z]+/) { + push(@ResultArray, $1); + } } print "\nVia Header details: \n"; - for (my $arrayIndex=0; $arrayIndex < scalar(@ResultArray); $arrayIndex++ ) { + for (my $arrayIndex = 0; $arrayIndex < scalar(@ResultArray); $arrayIndex++) { get_via_header_flags(\@proxy_header_array, $arrayIndex, $ResultArray[$arrayIndex]); } } #Get values from header arrays -sub get_via_header_flags { +sub get_via_header_flags +{ my ($arrayName, $inputIndex, $flag) = @_; my %flagValues; my @flagKeys; my %flags; my @keys; - + my @array = @$arrayName; - + %flagValues = %{$array[$inputIndex]}; - @flagKeys = keys (%flagValues); - - foreach my $keyEntry ( @flagKeys ) { - printf ("%-55s", $keyEntry); + @flagKeys = keys(%flagValues); + + foreach my $keyEntry (@flagKeys) { + printf("%-55s", $keyEntry); %flags = %{$flagValues{$keyEntry}}; - @keys = keys (%flags); - foreach my $key ( @keys ) { - if ($key =~ /$flag/) { - #print $flags{$key}; - printf("%s",$flags{$key}); - print "\n"; + @keys = keys(%flags); + foreach my $key (@keys) { + if ($key =~ /$flag/) { + #print $flags{$key}; + printf("%s", $flags{$key}); + print "\n"; } } }