In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7636ea95c57762930accf4358f7c0c2dec086b5e?hp=17fddc5cffca4f968d3565ff012c0cfb3af40d68>
- Log ----------------------------------------------------------------- commit 7636ea95c57762930accf4358f7c0c2dec086b5e Author: Ãvar Arnfjörð Bjarmason <[email protected]> Date: Thu Apr 15 17:12:04 2010 +0000 Set the legacy process name with prctl() on assignment to $0 on Linux Ever since perl 4.000 we've only set the POSIX process name via argv[0]. Unfortunately on Linux the POSIX name isn't used by utilities like top(1), ps(1) and killall(1). Now when we set C<$0 = "hello"> both C<qx[ps h $$]> (POSIX) and C<qx[ps hc $$]> (legacy) will say "hello", instead of the latter being "perl" as was previously the case. See also the March 9 2010 thread "Why doesn't assignment to $0 on Linux also call prctl()?" on perl5-porters. ----------------------------------------------------------------------- Summary of changes: handy.h | 3 +-- mg.c | 11 +++++++++++ pod/perlvar.pod | 7 +++++++ t/op/magic.t | 33 ++++++++++++++++++++++++++++++++- 4 files changed, 51 insertions(+), 3 deletions(-) diff --git a/handy.h b/handy.h index ebe523f..1ff7fde 100644 --- a/handy.h +++ b/handy.h @@ -214,8 +214,7 @@ typedef U64TYPE U64; * GMTIME_MAX GMTIME_MIN LOCALTIME_MAX LOCALTIME_MIN * HAS_CTIME64 HAS_LOCALTIME64 HAS_GMTIME64 HAS_DIFFTIME64 * HAS_MKTIME64 HAS_ASCTIME64 HAS_GETADDRINFO HAS_GETNAMEINFO - * HAS_INETNTOP HAS_INETPTON CHARBITS HAS_PRCTL_SET_NAME - * HAS_PRCTL + * HAS_INETNTOP HAS_INETPTON CHARBITS HAS_PRCTL * Not (yet) used at top level, but mention them for metaconfig */ diff --git a/mg.c b/mg.c index 4a8d767..0341f6e 100644 --- a/mg.c +++ b/mg.c @@ -57,6 +57,10 @@ tie. # include <sys/pstat.h> #endif +#ifdef HAS_PRCTL_SET_NAME +# include <sys/prctl.h> +#endif + #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) Signal_t Perl_csighandler(int sig, siginfo_t *, void *); #else @@ -2823,6 +2827,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_origargv[0][PL_origalen-1] = 0; for (i = 1; i < PL_origargc; i++) PL_origargv[i] = 0; +#ifdef HAS_PRCTL_SET_NAME + /* Set the legacy process name in addition to the POSIX name on Linux */ + if (prctl(PR_SET_NAME, (unsigned long)s, 0, 0, 0) != 0) { + /* diag_listed_as: SKIPME */ + Perl_croak(aTHX_ "Can't set $0 with prctl(): %s", Strerror(errno)); + } +#endif } #endif UNLOCK_DOLLARZERO_MUTEX; diff --git a/pod/perlvar.pod b/pod/perlvar.pod index febf15f..0dd2e1e 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -1026,6 +1026,13 @@ have their own copies of it. If the program has been given to perl via the switches C<-e> or C<-E>, C<$0> will contain the string C<"-e">. +On Linux as of perl 5.14 the legacy process name will be set with +L<prctl(2)>, in addition to altering the POSIX name via C<argv[0]> as +perl has done since version 4.000. Now system utilities that read the +legacy process name such as ps, top and killall will recognize the +name you set when assigning to C<$0>. The string you supply will be +cut off at 16 bytes, this is a limitation imposed by Linux. + =item $[ X<$[> diff --git a/t/op/magic.t b/t/op/magic.t index ff58352..bef4922 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -12,7 +12,7 @@ BEGIN { use warnings; use Config; -plan (tests => 81); +plan (tests => 83); $Is_MSWin32 = $^O eq 'MSWin32'; $Is_NetWare = $^O eq 'NetWare'; @@ -347,6 +347,37 @@ SKIP: { } } +# Check that assigning to $0 on Linux sets the process name with both +# argv[0] assignment and by calling prctl() +{ + SKIP: { + skip "We don't have prctl() here", 2 unless $Config{d_prctl_set_name}; + + # We don't really need these tests. prctl() is tested in the + # Kernel, but test it anyway for our sanity. If something doesn't + # work (like if the system doesn't have a ps(1) for whatever + # reason) just bail out gracefully. + my $maybe_ps = sub { + my ($cmd) = @_; + local ($?, $!); + + no warnings; + my $res = `$cmd`; + skip "Couldn't shell out to `$cmd', returned code $?", 2 if $?; + return $res; + }; + + my $name = "Good Morning, Dave"; + $0 = $name; + + chomp(my $argv0 = $maybe_ps->("ps h $$")); + chomp(my $prctl = $maybe_ps->("ps hc $$")); + + like($argv0, $name, "Set process name through argv[0] ($argv0)"); + like($prctl, substr($name, 0, 15), "Set process name through prctl() ($prctl)"); + } +} + { my $ok = 1; my $warn = ''; -- Perl5 Master Repository
