This is an automated email from the ASF dual-hosted git repository.
zwoop pushed a commit to branch master
in repository https://gitbox.apache.org/repos/asf/trafficserver.git
The following commit(s) were added to refs/heads/master by this push:
new 97aac1e Add Perltidy configuration and build target
97aac1e is described below
commit 97aac1e1a7d328076752dd032bca3967b0d22023
Author: Leif Hedstrom <[email protected]>
AuthorDate: Mon Feb 18 14:26:00 2019 -0700
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(-)
diff --git a/.perltidyrc b/.perltidyrc
new file mode 100644
index 0000000..86440f5
--- /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 15a411a..889be94 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 0fd0b75..83d293e 100755
--- a/ci/jenkins/ats_conf.pl
+++ b/ci/jenkins/ats_conf.pl
@@ -32,69 +32,69 @@ $recedit->append(line => "CONFIG
proxy.config.proxy_binary_opts STRING -M --disa
#$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 93a24d5..18c5c82 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 9cdd79c..ae25562 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 $fn = $ARGV[0] ||
"/usr/local/etc/trafficserver/records.config";
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 5f9aab6..937d5ce 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 4e9e7aa..d4a5007 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 5f69113..078aab8 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 ae5bc07..38cc523 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 6de4cc6..7cf3850 100755
--- a/plugins/experimental/url_sig/sign.pl
+++ b/plugins/experimental/url_sig/sign.pl
@@ -22,50 +22,50 @@ use Getopt::Long;
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 $j = 0;
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 "\nUrl: $url\n";
$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 <value> \\ \n";
- print " --useparts <value> \\ \n";
- print " --algorithm <value> \\ \n";
- print " --duration <value> \\ \n";
- print " --keyindex <value> \\ \n";
- print " [--client <value>] \\ \n";
- print " --key <value> \\ \n";
- print " [--verbose] \n";
- print " [--pathparams] \n";
- print " [--proxy <url:port value>] 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 <value> \\ \n";
+ print " --useparts <value> \\ \n";
+ print " --algorithm <value> \\ \n";
+ print " --duration <value> \\ \n";
+ print " --keyindex <value> \\ \n";
+ print " [--client <value>] \\ \n";
+ print " --key <value> \\ \n";
+ print " [--verbose] \n";
+ print " [--pathparams] \n";
+ print " [--proxy <url:port value>] 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 68e6d9d..24a6281 100644
--- a/proxy/http/test_http_client.pl
+++ b/proxy/http/test_http_client.pl
@@ -28,7 +28,6 @@ sub make_proxy_request($$$$$);
sub make_doc_filename($);
sub make_doc_http_filename($);
-
###########################################################
#
# global configuration parameters
@@ -44,54 +43,39 @@ my ($save_http_doc) = 0;
###########################################################
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 = <input>)
- {
- $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 = <input>) {
+ $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 process_input_http_requests_file($$$)
###########################################################
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($$$)
###########################################################
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 spawn_http_request($$$)
###########################################################
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 = <Host>)
- {
- 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 = <Host>) {
+ 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 process_http_response($$$$)
###########################################################
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_proxy_request($$$$$)
###########################################################
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_filename($)
###########################################################
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 <input file> <number of users>',
"\n";
- print 'use proxy: test_http_client <input file> <number of users> ';
- print '<proxy host> <proxy port>', "\n";
- exit;
+if ($#ARGV != 1 and $#ARGV != 3) {
+ print 'no proxy : test_http_client <input file> <number of users>', "\n";
+ print 'use proxy: test_http_client <input file> <number of users> ';
+ print '<proxy host> <proxy port>', "\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 94de375..6465477 100644
--- a/proxy/http/test_proxy.pl
+++ b/proxy/http/test_proxy.pl
@@ -29,16 +29,15 @@ sub make_proxy_request($$$$$);
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 @@ glob ($method) = "GET"; #method to use in http requests
###########################################################
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 compare_files($$$)
###########################################################
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 spawn_task($$$$)
###########################################################
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 = <Host>)
- {
- 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 = <Host>) {
+ 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: <host_name><doc_name>
+ #
+ # subroutine: make_doc_filename request
+ #
+ # file name is: <host_name><doc_name>
###########################################################
-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 <input file> <number of users>',
"\n";
- print 'use proxy: test_http_client <input file> <number of users> ';
- print '<proxy host> <proxy port>', "\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 <input file> <number of users>',
"\n";
+ print 'use proxy: test_http_client <input file> <number of users> ';
+ print '<proxy host> <proxy port>', "\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 ba62f09..0de170e 100755
--- a/tools/changelog.pl
+++ b/tools/changelog.pl
@@ -22,105 +22,96 @@ use warnings;
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 @@ my $curl = WWW::Curl::Easy->new;
#$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 @@ my $page = 1;
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 cf00463..eb16cd4 100755
--- a/tools/compare_records.pl
+++ b/tools/compare_records.pl
@@ -38,35 +38,39 @@ use strict;
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 <filename1> -f <filename2>\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 <filename1> -f <filename2>\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 @@ my $in_file2 = $file_list[1];
# 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 @@ my %common1_settings = %$common1;
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 7f1bcb8..4c485da 100755
--- a/tools/compare_servers.pl
+++ b/tools/compare_servers.pl
@@ -28,218 +28,232 @@ use Digest::SHA1;
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 = <FILE>) {
- 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 = <FILE>) {
+ 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 8f15a93..4e9e92d 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(<DATA>) {
+ while (<DATA>) {
my @items = split;
chomp @items;
@@ -49,11 +52,13 @@ my %diff;
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 49e93a4..db40600 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 9207b59..81fb52d 100755
--- a/tools/slow_log_report.pl
+++ b/tools/slow_log_report.pl
@@ -21,62 +21,72 @@ use strict;
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 6eee2a6..e5a0f29 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 @@ my $help;
#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 @@ my @proxy_header_array = (
'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 @@ if (@ARGV == 0) {
#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 @@ if (@ARGV == 0) {
}
#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";
}
}
}
