84 lines
2.1 KiB
Perl
84 lines
2.1 KiB
Perl
|
#!/usr/bin/env perl
|
||
|
|
|
||
|
|
# Daniel Bowling <dbowling@akamai.com>
|
||
|
|
# Feb 2020
|
||
|
|
# version 0.21 - update $ver @ line 23
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use LWP::UserAgent;
|
||
|
|
use Getopt::Long qw(:config no_ignore_case);
|
||
|
|
|
||
|
|
# Parse options
|
||
|
|
GetOptions(
|
||
|
|
'delimiter|d=s' => \my $sep,
|
||
|
|
'header|H' => \my $head,
|
||
|
|
'help|h', # technically does nothing right now
|
||
|
|
'version|v' => \my $ver,
|
||
|
|
'wait|w=i' => \my $wait
|
||
|
|
);
|
||
|
|
|
||
|
|
# Version info option
|
||
|
|
if ($ver) {
|
||
|
|
$ver = '0.21';
|
||
|
|
print "$ver\n";
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Choose what to do given args, STDIN, or null
|
||
|
|
if (@ARGV) {
|
||
|
|
@_ = @ARGV # use args or...
|
||
|
|
} elsif (! -t STDIN) {
|
||
|
|
chomp (@_ = <STDIN>) # use STDIN or...
|
||
|
|
} else {
|
||
|
|
print "Usage: $0 <HOSTNAME(S)>\n\n"; # null, print help
|
||
|
|
die <<'OPTIONS';
|
||
|
|
Find CP code from hostnames provided as arguments or STDIN.
|
||
|
|
-d, --delimiter=DELIM Change delimiting character (default is TAB)
|
||
|
|
-H, --header Print header with output lines
|
||
|
|
-h, --help Print this help message
|
||
|
|
-v, --version Print version
|
||
|
|
-w, --wait Set timeout value (default is 10)
|
||
|
|
OPTIONS
|
||
|
|
}
|
||
|
|
|
||
|
|
$sep = "\t" if ! $sep; # Delimiter character
|
||
|
|
$wait = 10 if ! $wait; # Timeout value
|
||
|
|
|
||
|
|
# Define function to grab CP code from response headers
|
||
|
|
sub get_cp {
|
||
|
|
# Declare some variables
|
||
|
|
my ($ua, @reqheaders, $response, @ckey);
|
||
|
|
|
||
|
|
# Create new LWP::UserAgent object & set timeout
|
||
|
|
$ua = LWP::UserAgent->new(
|
||
|
|
'timeout' => "$wait",
|
||
|
|
'max_redirect' => '0'
|
||
|
|
);
|
||
|
|
|
||
|
|
# Add Pragma header to request headers
|
||
|
|
@reqheaders = (
|
||
|
|
'Pragma' => 'akamai-x-get-cache-key'
|
||
|
|
);
|
||
|
|
|
||
|
|
# Make HTTP request
|
||
|
|
$response = $ua->head("http://@_", @reqheaders);
|
||
|
|
|
||
|
|
# Return CP code
|
||
|
|
if ($response->header("X-Cache-Key")) {
|
||
|
|
@ckey = split(/\//, $response->header("X-Cache-Key"));
|
||
|
|
return $ckey[3]; # CP code field of cache key
|
||
|
|
} else {
|
||
|
|
return "?"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Print header if -H|--header is specified
|
||
|
|
print "Hostname${sep}CP Code\n" if $head;
|
||
|
|
|
||
|
|
# Begin parsing hostnames
|
||
|
|
for (@_) {
|
||
|
|
# Print hostname, delimiter, CP code and newline
|
||
|
|
print $_ . $sep . get_cp($_) . "\n";
|
||
|
|
}
|