use warnings;
use Getopt::Long;
use File::Temp;
+use LWP::UserAgent;
+use File::Copy;
my $PPROF_VERSION = "1.5";
my $KCACHEGRIND = "kcachegrind";
my $PS2PDF = "ps2pdf";
# These are used for dynamic profiles
-my $CURL = "curl";
# These are the web pages that servers need to support for dynamic profiles
my $HEAP_PAGE = "/pprof/heap";
my $OS = $^O;
my $DEVNULL = "/dev/null";
if ($^O =~ /MSWin32|cygwin|msys/) {
- $OS = "windows";
- $DEVNULL = "NUL";
+ $OS = "windows";
+ $DEVNULL = "NUL";
}
##### Argument parsing #####
sub CheckSymbolPage {
my $url = SymbolPageURL();
print STDERR "Read $url\n";
- open(SYMBOL, "$CURL -s '$url' |");
- my $line = <SYMBOL>;
+
+ my $ua = LWP::UserAgent->new;
+ my $response = $ua->get($url);
+ error("Failed to get symbol page from $url\n") unless $response->is_success;
+
+ my $line = $response->content;
$line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
- close(SYMBOL);
unless (defined($line)) {
error("$url doesn't exist\n");
}
sub FetchProgramName() {
my ($scheme, $host, $port, $prefix, $path) = ParseProfileURL($main::pfile_args[0]);
my $url = "$scheme://$host:$port$prefix$PROGRAM_NAME_PAGE";
- my $command_line = "$CURL -s '$url'";
- open(CMDLINE, "$command_line |") or error($command_line);
- my $cmdline = <CMDLINE>;
+
+ my $ua = LWP::UserAgent->new;
+ my $response = $ua->get($url);
+ error("Failed to get program name from $url\n") unless $response->is_success;
+ my $cmdline = $response->content;
+
+ $cmdline =~ s/\n.*//s;
$cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines
- close(CMDLINE);
error("Failed to get program name from $url\n") unless defined($cmdline);
$cmdline =~ s/\x00.+//; # Remove argv[1] and latters.
$cmdline =~ s!\n!!g; # Remove LFs.
return $cmdline;
}
-# Gee, curl's -L (--location) option isn't reliable at least
-# with its 7.12.3 version. Curl will forget to post data if
-# there is a redirection. This function is a workaround for
-# curl. Redirection happens on borg hosts.
-sub ResolveRedirectionForCurl {
- my $url = shift;
- my $command_line = "$CURL -s --head '$url'";
- open(CMDLINE, "$command_line |") or error($command_line);
- while (<CMDLINE>) {
- s/\r//g; # turn windows-looking lines into unix-looking lines
- if (/^Location: (.*)/) {
- $url = $1;
- }
- }
- close(CMDLINE);
- return $url;
-}
-
# Reads a symbol map from the file handle name given as $1, returning
# the resulting symbol map. Also processes variables relating to symbols.
# Currently, the only variable processed is 'binary=<value>' which updates
close(POSTFILE);
my $url = SymbolPageURL();
- $url = ResolveRedirectionForCurl($url);
- my $command_line = "$CURL -sd '\@$main::tmpfile_sym' '$url'";
- open(SYMBOL, "$command_line |") or error($command_line);
+ my $req = HTTP::Request->new(POST => $url);
+ $req->content($post_data);
+ my $lwp = LWP::UserAgent->new;
+ my $response = $lwp->request($req);
+
+ my $tmp_symbol = File::Temp->new()->filename;
+ open(SYMBOL, ">$tmp_symbol");
+ print SYMBOL $response->content;
+ close(SYMBOL);
+
+ open(SYMBOL, "<$tmp_symbol") || error("$tmp_symbol");
ReadSymbols(*SYMBOL{IO}, $symbol_map);
close(SYMBOL);
}
my $profile_file = MakeProfileBaseName($binary_name, $profile_name);
my $url;
- my $curl_timeout;
+ my $timeout;
if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)) {
if ($path =~ m/$PROFILE_PAGE/) {
$url = sprintf("$scheme://$host:$port$prefix$path?seconds=%d",
$url = sprintf("$scheme://$profile_name" . "seconds=%d",
$main::opt_seconds);
}
- $curl_timeout = sprintf("--max-time %d",
+ $timeout = sprintf("%d",
int($main::opt_seconds * 1.01 + 60));
} else {
# For non-CPU profiles, we add a type-extension to
$suffix =~ s,/,.,g;
$profile_file .= "$suffix";
$url = "$scheme://$host:$port$prefix$path";
- $curl_timeout = "";
+ $timeout = "";
}
- my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof");
- if (!(-d $profile_dir)) {
- mkdir($profile_dir)
- || die("Unable to create profile directory $profile_dir: $!\n");
- }
- my $tmp_profile = "$profile_dir/.tmp.$profile_file";
- my $real_profile = "$profile_dir/$profile_file";
+ my $tmp_profile = File::Temp->new()->filename;
+ my $real_profile = File::Temp->new()->filename;
if ($fetch_name_only > 0) {
return $real_profile;
}
- my $cmd = "$CURL $curl_timeout -s -o $tmp_profile '$url'";
if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){
print STDERR "Gathering CPU profile from $url for $main::opt_seconds seconds to\n ${real_profile}\n";
if ($encourage_patience) {
print STDERR "Fetching $path profile from $host:$port to\n ${real_profile}\n";
}
- (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n");
- open(TMPPROF, "$tmp_profile") || error("Cannot open $tmp_profile: $!\n");
- my $line = <TMPPROF>;
- close(TMPPROF);
+ my $ua = LWP::UserAgent->new;
+ $ua->timeout($timeout);
+ my $response = $ua->get($url);
+
+ error("Failed to get profile: $url $timeout!\n") unless $response->is_success;
+
+ open(OUTFILE, ">$tmp_profile");
+ binmode(OUTFILE);
+ print OUTFILE $response->content;
+ close(OUTFILE);
+
+ my $line = $response->content;
$line !~ /^Could not enable CPU profiling/ || error($line);
- (system("mv $tmp_profile $real_profile") == 0) || error("Unable to rename profile\n");
+
+ copy($tmp_profile, $real_profile) || error("Unable to copy profile\n");
print STDERR "Wrote profile to $real_profile\n";
$main::collected_profile = $real_profile;
return $main::collected_profile;
sub cleanup {
unlink($main::tmpfile_sym);
unlink(keys %main::tempnames);
+ if (defined($main::collected_profile)) {
+ unlink($main::collected_profile);
+ }
# We leave any collected profiles in $HOME/pprof in case the user wants
# to look at them later. We print a message informing them of this.