From ccfe1bfd92461e2743d1004da0365ac2b33f2a6a Mon Sep 17 00:00:00 2001 From: Brad Fitzpatrick Date: Thu, 29 Aug 2013 16:42:13 -0700 Subject: [PATCH] misc/pprof: work with either LWP::UserAgent or curl Use either LWP::UserAgent or curl to make HTTP requests so it works on Windows (most Perl distros include LWP::UserAgent), and also on OS X (whose Perl at least sometimes doesn't include LWP::UserAgent). Fixes #6273 R=golang-dev, alex.brainman, cldorian CC=golang-dev https://golang.org/cl/13330044 --- misc/pprof | 99 ++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 62 insertions(+), 37 deletions(-) diff --git a/misc/pprof b/misc/pprof index 35749483fd3..ed399dae40f 100755 --- a/misc/pprof +++ b/misc/pprof @@ -79,7 +79,6 @@ use strict; use warnings; use Getopt::Long; use File::Temp; -use LWP::UserAgent; use File::Copy; my $PPROF_VERSION = "1.5"; @@ -502,7 +501,7 @@ sub Init() { # Remote profiling without a binary (using $SYMBOL_PAGE instead) if (IsProfileURL($ARGV[0])) { $main::use_symbol_page = 1; - } elsif (IsSymbolizedProfileFile($ARGV[0])) { + } elsif ($ARGV[0] && IsSymbolizedProfileFile($ARGV[0])) { $main::use_symbolized_profile = 1; $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file } @@ -2979,11 +2978,7 @@ sub CheckSymbolPage { my $url = SymbolPageURL(); print STDERR "Read $url\n"; - 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; + my $line = FetchHTTP($url); $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines unless (defined($line)) { error("$url doesn't exist\n"); @@ -3027,12 +3022,8 @@ sub FetchProgramName() { my ($scheme, $host, $port, $prefix, $path) = ParseProfileURL($main::pfile_args[0]); my $url = "$scheme://$host:$port$prefix$PROGRAM_NAME_PAGE"; - 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; + my $cmdline = FetchHTTP($url); + $cmdline =~ s/\n.*//s; # first line only $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines error("Failed to get program name from $url\n") unless defined($cmdline); $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. @@ -3091,19 +3082,12 @@ sub FetchSymbols { $symbol_map = {}; my $post_data = join("+", sort((map {"0x" . "$_"} @pcs))); - open(POSTFILE, ">$main::tmpfile_sym"); - print POSTFILE $post_data; - close(POSTFILE); - my $url = SymbolPageURL(); - my $req = HTTP::Request->new(POST => $url); - $req->content($post_data); - my $lwp = LWP::UserAgent->new; - my $response = $lwp->request($req); + my $content = PostHTTP($url, $post_data); my $tmp_symbol = File::Temp->new()->filename; open(SYMBOL, ">$tmp_symbol"); - print SYMBOL $response->content; + print SYMBOL $content; close(SYMBOL); open(SYMBOL, "<$tmp_symbol") || error("$tmp_symbol"); @@ -3186,8 +3170,7 @@ sub FetchDynamicProfile { $url = sprintf("$scheme://$profile_name" . "seconds=%d", $main::opt_seconds); } - $timeout = sprintf("%d", - int($main::opt_seconds * 1.01 + 60)); + $timeout = int($main::opt_seconds * 1.01 + 60); } else { # For non-CPU profiles, we add a type-extension to # the target profile file name. @@ -3195,7 +3178,6 @@ sub FetchDynamicProfile { $suffix =~ s,/,.,g; $profile_file .= "$suffix"; $url = "$scheme://$host:$port$prefix$path"; - $timeout = ""; } my $tmp_profile = File::Temp->new()->filename; @@ -3214,18 +3196,14 @@ sub FetchDynamicProfile { print STDERR "Fetching $path profile from $host:$port to\n ${real_profile}\n"; } - 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; + my $content = FetchHTTP($url, $timeout); open(OUTFILE, ">$tmp_profile"); binmode(OUTFILE); - print OUTFILE $response->content; + print OUTFILE $content; close(OUTFILE); - my $line = $response->content; + my $line = $content; $line !~ /^Could not enable CPU profiling/ || error($line); copy($tmp_profile, $real_profile) || error("Unable to copy profile\n"); @@ -4680,12 +4658,59 @@ sub ConfigureTool { return $path; } -sub cleanup { - unlink($main::tmpfile_sym); - unlink(keys %main::tempnames); - if (defined($main::collected_profile)) { - unlink($main::collected_profile); +# FetchHTTP retrieves a URL using either curl or LWP::UserAgent. +# It returns the entire body of the page on success, or exits the program +# with an error message on any failure. +sub FetchHTTP { + my $url = shift; + my $timeout = shift; # optional, in seconds + eval "use LWP::UserAgent ();"; + if ($@) { + my @max; + push @max, "--max-time", $timeout if $timeout; + open(my $fh, "-|", "curl", @max, "-s", $url) or error("Neither LWP::UserAgent nor curl is installed: $!\n"); + my $slurp = do { local $/; <$fh> }; + close($fh); + if ($? != 0) { + error("Error fetching $url with curl: exit $?") + } + return $slurp; } + my $ua = LWP::UserAgent->new; + $ua->timeout($timeout) if $timeout; + my $res = $ua->get($url); + error("Failed to fetch $url\n") unless $res->is_success(); + return $res->content(); +} + +sub PostHTTP { + my ($url, $post_data) = @_; + eval "use LWP::UserAgent ();"; + if ($@) { + open(POSTFILE, ">$main::tmpfile_sym"); + print POSTFILE $post_data; + close(POSTFILE); + + open(my $fh, "-|", "curl", "-s", "-d", "\@$main::tmpfile_sym", $url) or error("Neither LWP::UserAgent nor curl is installed: $!\n"); + my $slurp = do { local $/; <$fh> }; + close($fh); + if ($? != 0) { + error("Error fetching $url with curl: exit $?") + } + return $slurp; + } + my $req = HTTP::Request->new(POST => $url); + $req->content($post_data); + my $ua = LWP::UserAgent->new; + my $res = $ua->request($req); + error("Failed to POST to $url\n") unless $res->is_success(); + return $res->content(); +} + +sub cleanup { + unlink($main::tmpfile_sym) if defined $main::tmpfile_sym; + unlink(keys %main::tempnames) if %main::tempnames; + unlink($main::collected_profile) if defined $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.