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.

diff --git a/handy.h b/handy.h
index ebe523f..1ff7fde 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 = '';