gnu: glibc: Add patch implementing "pid/…" magic lookup on the Hurd.

This patch is missing from glibc 2.28 and is needed to support
/proc/self lookup when using the Hurd's procfs, which in turn is needed
for our 'guile-relocatable.patch'.

See <https://lists.gnu.org/archive/html/bug-hurd/2018-12/msg00024.html>.

* gnu/packages/patches/glibc-hurd-magic-pid.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/base.scm (glibc)[arguments]: Add 'apply-hurd-patch'
phase.
[native-inputs]: Add "hurd-magic-pid-patch" input.
* gnu/packages/cross-base.scm (cross-libc)[arguments]: Duplicate
'apply-hurd-patch' phase.

3 files changed, 225 insertions, 2 deletions

diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 60f8051dc6..e79d2a987b 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -681,6 +681,18 @@ store.")
 
       #:tests? #f                                 ; XXX
       #:phases (modify-phases %standard-phases
+                 ,@(if (hurd-target?)
+                       `((add-after 'unpack 'apply-hurd-patch
+                           (lambda* (#:key inputs native-inputs
+                                     #:allow-other-keys)
+                             ;; TODO: Move this to 'patches' field.
+                             (let ((patch (or (assoc-ref native-inputs
+                                                         "hurd-magic-pid-patch")
+                                              (assoc-ref inputs
+                                                         "hurd-magic-pid-patch"))))
+                               (invoke "patch" "-p1" "--force" "--input"
+                                       patch)))))
+                       '())
                  (add-before
                   'configure 'pre-configure
                   (lambda* (#:key inputs native-inputs outputs
@@ -806,7 +818,9 @@ store.")
 
                     ,@(if (hurd-target?)
                           `(("mig" ,mig)
-                            ("perl" ,perl))
+                            ("perl" ,perl)
+                            ("hurd-magic-pid-patch"
+                             ,(search-patch "glibc-hurd-magic-pid.patch")))
                           '())))
 
    (native-search-paths
diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index 2fcb7fb36b..bb3d6d916a 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -454,6 +454,23 @@ XBINUTILS and the cross tool chain."
                           flags)))
              ((#:phases phases)
               `(modify-phases ,phases
+                 ;; XXX: The hack below allows us to make sure the
+                 ;; 'apply-hurd-patch' phase gets added in the first
+                 ;; cross-libc, but does *not* get added twice subsequently
+                 ;; when cross-building another libc.
+                 ,@(if (and (hurd-triplet? target)
+                            (not (hurd-target?)))
+                       `((add-after 'unpack 'apply-hurd-patch
+                           (lambda* (#:key inputs native-inputs
+                                     #:allow-other-keys)
+                             ;; TODO: Move this to 'patches' field.
+                             (let ((patch (or (assoc-ref native-inputs
+                                                         "hurd-magic-pid-patch")
+                                              (assoc-ref inputs
+                                                         "hurd-magic-pid-patch"))))
+                               (invoke "patch" "-p1" "--force" "--input"
+                                       patch)))))
+                       '())
                  (add-before 'configure 'set-cross-kernel-headers-path
                    (lambda* (#:key inputs #:allow-other-keys)
                      (let* ((kernel (assoc-ref inputs "kernel-headers"))
@@ -477,7 +494,9 @@ XBINUTILS and the cross tool chain."
                            ,@(if (hurd-triplet? target)
                                  `(("cross-mig"
                                     ,@(assoc-ref (package-native-inputs xheaders)
-                                                 "cross-mig")))
+                                                 "cross-mig"))
+                                   ("hurd-magic-pid-patch"
+                                    ,(search-patch "glibc-hurd-magic-pid.patch")))
                                  '())
                            ,@(package-inputs libc)     ;FIXME: static-bash
                            ,@(package-native-inputs libc)))))))
diff --git a/gnu/packages/patches/glibc-hurd-magic-pid.patch b/gnu/packages/patches/glibc-hurd-magic-pid.patch
new file mode 100644
index 0000000000..a6849f7d35
--- /dev/null
+++ b/gnu/packages/patches/glibc-hurd-magic-pid.patch
@@ -0,0 +1,190 @@
+This patch implements "magic" lookup for "pid/…", as used when looking up
+/proc/self.
+
+The patch comes from the 't/magic-pid' branch
+at <https://git.savannah.gnu.org/cgit/hurd/glibc.git>.  It squashes
+commit 392e52286a302ca6157fbd221295e64ab6b6d8ba (by Justus Winter)
+and commit 392e52286a302ca6157fbd221295e64ab6b6d8ba (a subsequent fix by
+Samuel Thibault).
+
+From: Justus Winter <4winter@informatik.uni-hamburg.de>
+Subject: [PATCH] hurd: Handle `pid' magical lookup retry
+
+        * hurd/lookup-retry.c: Handle `pid' magical lookup
+        retry.
+
+diff --git a/hurd/lookup-retry.c b/hurd/lookup-retry.c
+index aee2ba8f93..6ed8de1653 100644
+--- a/hurd/lookup-retry.c
++++ b/hurd/lookup-retry.c
+@@ -25,6 +25,7 @@
+ #include <string.h>
+ #include <_itoa.h>
+ #include <eloop-threshold.h>
++#include <unistd.h>
+ 
+ /* Translate the error from dir_lookup into the error the user sees.  */
+ static inline error_t
+@@ -59,6 +60,7 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+   error_t err;
+   char *file_name;
+   int nloops;
++  file_t lastdir = MACH_PORT_NULL;
+ 
+   error_t lookup_op (file_t startdir)
+     {
+@@ -107,14 +109,15 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 	{
+ 	case FS_RETRY_REAUTH:
+ 	  if (err = reauthenticate (*result))
+-	    return err;
++	    goto out;
+ 	  /* Fall through.  */
+ 
+ 	case FS_RETRY_NORMAL:
+ 	  if (nloops++ >= __eloop_threshold ())
+ 	    {
+ 	      __mach_port_deallocate (__mach_task_self (), *result);
+-	      return ELOOP;
++	      err = ELOOP;
++	      goto out;
+ 	    }
+ 
+ 	  /* An empty RETRYNAME indicates we have the final port.  */
+@@ -174,7 +177,7 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 
+ 	      if (err)
+ 		__mach_port_deallocate (__mach_task_self (), *result);
+-	      return err;
++	      goto out;
+ 	    }
+ 
+ 	  startdir = *result;
+@@ -189,7 +192,10 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 	      if (*result != MACH_PORT_NULL)
+ 		__mach_port_deallocate (__mach_task_self (), *result);
+ 	      if (nloops++ >= __eloop_threshold ())
+-		return ELOOP;
++		{
++		  err = ELOOP;
++		  goto out;
++		}
+ 	      file_name = &retryname[1];
+ 	      break;
+ 
+@@ -208,7 +214,8 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 		      (*end != '/' && *end != '\0'))
+ 		    {
+ 		      errno = save;
+-		      return ENOENT;
++		      err = ENOENT;
++		      goto out;
+ 		    }
+ 		  if (! get_dtable_port)
+ 		    err = EGRATUITOUS;
+@@ -226,9 +233,12 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 		    }
+ 		  errno = save;
+ 		  if (err)
+-		    return err;
++		    goto out;
+ 		  if (*end == '\0')
+-		    return 0;
++		    {
++		      err = 0;
++		      goto out;
++		    }
+ 		  else
+ 		    {
+ 		      /* Do a normal retry on the remaining components.  */
+@@ -255,9 +265,12 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 		  if (err = __host_info (__mach_host_self (), HOST_BASIC_INFO,
+ 					 (integer_t *) &hostinfo,
+ 					 &hostinfocnt))
+-		    return err;
++		    goto out;
+ 		  if (hostinfocnt != HOST_BASIC_INFO_COUNT)
+-		    return EGRATUITOUS;
++		    {
++		      err = EGRATUITOUS;
++		      goto out;
++		    }
+ 		  p = _itoa (hostinfo.cpu_subtype, &retryname[8], 10, 0);
+ 		  *--p = '/';
+ 		  p = _itoa (hostinfo.cpu_type, &retryname[8], 10, 0);
+@@ -293,10 +306,11 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 		      }
+ 
+ 		  case '\0':
+-		    return opentty (result);
++		    err = opentty (result);
++		    goto out;
+ 		  case '/':
+ 		    if (err = opentty (&startdir))
+-		      return err;
++		      goto out;
+ 		    strcpy (retryname, &retryname[4]);
+ 		    break;
+ 		  default:
+@@ -306,14 +320,48 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 		goto bad_magic;
+ 	      break;
+ 
++	    case 'p':
++	      if (retryname[1] == 'i' && retryname[2] == 'd' &&
++		  (retryname[3] == '/' || retryname[3] == 0))
++		{
++		  char *p, buf[1024];  /* XXX */
++		  size_t len;
++		  p = _itoa (__getpid (), &buf[sizeof buf], 10, 0);
++		  len = &buf[sizeof buf] - p;
++		  memcpy (buf, p, len);
++		  strcpy (buf + len, &retryname[3]);
++		  strcpy (retryname, buf);
++
++		  /* Do a normal retry on the remaining components.  */
++		  __mach_port_mod_refs (__mach_task_self (), lastdir,
++					MACH_PORT_RIGHT_SEND, 1);
++		  startdir = lastdir;
++		  file_name = retryname;
++		}
++	      else
++		goto bad_magic;
++	      break;
++
+ 	    default:
+ 	    bad_magic:
+-	      return EGRATUITOUS;
++	      err = EGRATUITOUS;
++	      goto out;
+ 	    }
+ 	  break;
+ 
+ 	default:
+-	  return EGRATUITOUS;
++	  err = EGRATUITOUS;
++	  goto out;
++	}
++
++      if (MACH_PORT_VALID (*result) && *result != lastdir)
++	{
++	  if (MACH_PORT_VALID (lastdir))
++	    __mach_port_deallocate (__mach_task_self (), lastdir);
++
++	  lastdir = *result;
++	  __mach_port_mod_refs (__mach_task_self (), lastdir,
++				MACH_PORT_RIGHT_SEND, 1);
+ 	}
+ 
+       if (startdir != MACH_PORT_NULL)
+@@ -326,6 +374,10 @@ __hurd_file_name_lookup_retry (error_t (*use_init_port)
+ 	err = (*use_init_port) (dirport, &lookup_op);
+     } while (! err);
+ 
++out:
++  if (MACH_PORT_VALID (lastdir))
++    __mach_port_deallocate (__mach_task_self (), lastdir);
++
+   return err;
+ }
+ weak_alias (__hurd_file_name_lookup_retry, hurd_file_name_lookup_retry)