diff options
| -rw-r--r-- | handy.h | 3 | ||||
| -rw-r--r-- | mg.c | 11 | ||||
| -rw-r--r-- | pod/perlvar.pod | 7 | ||||
| -rw-r--r-- | t/op/magic.t | 33 |
4 files changed, 51 insertions, 3 deletions
@@ -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 */ @@ -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 febf15f65f..0dd2e1e2f1 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 ff5835232c..bef4922719 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 = ''; |