summary refs log tree commit diff
path: root/gnu/packages/patches
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-12-20 18:39:04 +0100
committerLudovic Courtès <ludo@gnu.org>2018-12-20 18:39:04 +0100
commit86974d8a9247cbeb938b5202f23ccca8d9ed627d (patch)
tree7bd498ccf672aced617aa24a830ec4164268c03f /gnu/packages/patches
parent03a45a40227d97ccafeb49c4eb0fc7539f4d2127 (diff)
parent9012d226fa46229a84e49a42c9b6d287105dfddf (diff)
downloadguix-86974d8a9247cbeb938b5202f23ccca8d9ed627d.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/packages/patches')
-rw-r--r--gnu/packages/patches/allegro-fix-compilation-mesa-18.2.5-and-later.patch41
-rw-r--r--gnu/packages/patches/ansible-wrap-program-hack.patch22
-rw-r--r--gnu/packages/patches/glibc-hurd-magic-pid.patch190
-rw-r--r--gnu/packages/patches/qemu-CVE-2018-16847.patch158
-rw-r--r--gnu/packages/patches/qemu-CVE-2018-16867.patch49
-rw-r--r--gnu/packages/patches/stumpwm-fix-broken-read-one-line.patch45
6 files changed, 276 insertions, 229 deletions
diff --git a/gnu/packages/patches/allegro-fix-compilation-mesa-18.2.5-and-later.patch b/gnu/packages/patches/allegro-fix-compilation-mesa-18.2.5-and-later.patch
new file mode 100644
index 0000000000..fa273a5dfa
--- /dev/null
+++ b/gnu/packages/patches/allegro-fix-compilation-mesa-18.2.5-and-later.patch
@@ -0,0 +1,41 @@
+Fixes compilation with Mesa >= 18.2.5.
+
+Taken from upstream:
+
+https://github.com/liballeg/allegro5/commit/a40d30e21802ecf5c9382cf34af9b01bd3781e47
+
+diff --git a/include/allegro5/allegro_opengl.h b/include/allegro5/allegro_opengl.h
+index 0f86a6768..652dd024e 100644
+--- a/include/allegro5/allegro_opengl.h
++++ b/include/allegro5/allegro_opengl.h
+@@ -103,10 +103,14 @@
+
+ /* HACK: Prevent both Mesa and SGI's broken headers from screwing us */
+ #define __glext_h_
++#define __gl_glext_h_
+ #define __glxext_h_
++#define __glx_glxext_h_
+ #include <GL/gl.h>
+ #undef  __glext_h_
++#undef  __gl_glext_h_
+ #undef  __glxext_h_
++#undef  __glx_glxext_h_
+
+ #endif /* ALLEGRO_MACOSX */
+
+diff --git a/include/allegro5/opengl/GLext/glx_ext_defs.h b/include/allegro5/opengl/GLext/glx_ext_defs.h
+index 49c502091..fba8aea5d 100644
+--- a/include/allegro5/opengl/GLext/glx_ext_defs.h
++++ b/include/allegro5/opengl/GLext/glx_ext_defs.h
+@@ -1,7 +1,9 @@
+ /* HACK: Prevent both Mesa and SGI's broken headers from screwing us */
+ #define __glxext_h_
++#define __glx_glxext_h_
+ #include <GL/glx.h>
+ #undef __glxext_h_
++#undef __glx_glxext_h_
+
+ #ifndef GLX_VERSION_1_3
+ #define _ALLEGRO_GLX_VERSION_1_3
+--
+2.20.0
diff --git a/gnu/packages/patches/ansible-wrap-program-hack.patch b/gnu/packages/patches/ansible-wrap-program-hack.patch
deleted file mode 100644
index c2e1028392..0000000000
--- a/gnu/packages/patches/ansible-wrap-program-hack.patch
+++ /dev/null
@@ -1,22 +0,0 @@
-Ansible changes its behaviour depending on the name of the script that it is
-called as. Make it deal with guix' .real wrapper scripts.
-
-FIXME: Remove once wrapping ansible works properly.
-See http://lists.gnu.org/archive/html/bug-guix/2017-05/msg00015.html.
---- ansible-2.3.0.0/bin/ansible	2017-04-12 16:08:05.000000000 +0200
-+++ ansible-2.3.0.0-fixed/bin/ansible	2017-05-21 20:11:18.720872385 +0200
-@@ -75,7 +75,13 @@
-             # sometimes add that
-             target = target[:-1]
-
--        if len(target) > 1:
-+        if target[-1] == "real" and target[0].startswith('.'):
-+            target = target[:-1]
-+            target[0] = target[0][1:]
-+        if len(target) > 1 and target[1] != "real" :
-+            sub = target[1]
-+            myclass = "%sCLI" % sub.capitalize()
-+        elif len(target) > 2 and target[2] == "real" :
-             sub = target[1]
-             myclass = "%sCLI" % sub.capitalize()
-         elif target[0] == 'ansible':
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)
diff --git a/gnu/packages/patches/qemu-CVE-2018-16847.patch b/gnu/packages/patches/qemu-CVE-2018-16847.patch
deleted file mode 100644
index c76bdf764a..0000000000
--- a/gnu/packages/patches/qemu-CVE-2018-16847.patch
+++ /dev/null
@@ -1,158 +0,0 @@
-Fix CVE-2018-16847:
-
-https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2018-16847
-
-Patch copied from upstream source repository:
-
-https://git.qemu.org/?p=qemu.git;a=commitdiff;h=87ad860c622cc8f8916b5232bd8728c08f938fce
-
-From 87ad860c622cc8f8916b5232bd8728c08f938fce Mon Sep 17 00:00:00 2001
-From: Paolo Bonzini <pbonzini@redhat.com>
-Date: Tue, 20 Nov 2018 19:41:48 +0100
-Subject: [PATCH] nvme: fix out-of-bounds access to the CMB
-MIME-Version: 1.0
-Content-Type: text/plain; charset=UTF-8
-Content-Transfer-Encoding: 8bit
-
-Because the CMB BAR has a min_access_size of 2, if you read the last
-byte it will try to memcpy *2* bytes from n->cmbuf, causing an off-by-one
-error.  This is CVE-2018-16847.
-
-Another way to fix this might be to register the CMB as a RAM memory
-region, which would also be more efficient.  However, that might be a
-change for big-endian machines; I didn't think this through and I don't
-know how real hardware works.  Add a basic testcase for the CMB in case
-somebody does this change later on.
-
-Cc: Keith Busch <keith.busch@intel.com>
-Cc: qemu-block@nongnu.org
-Reported-by: Li Qiang <liq3ea@gmail.com>
-Reviewed-by: Li Qiang <liq3ea@gmail.com>
-Tested-by: Li Qiang <liq3ea@gmail.com>
-Signed-off-by: Paolo Bonzini <pbonzini@redhat.com>
-Reviewed-by: Philippe Mathieu-Daudé <philmd@redhat.com>
-Tested-by: Philippe Mathieu-Daudé <philmd@redhat.com>
-Signed-off-by: Kevin Wolf <kwolf@redhat.com>
----
- hw/block/nvme.c        |  2 +-
- tests/Makefile.include |  2 +-
- tests/nvme-test.c      | 68 +++++++++++++++++++++++++++++++++++-------
- 3 files changed, 60 insertions(+), 12 deletions(-)
-
-diff --git a/hw/block/nvme.c b/hw/block/nvme.c
-index 28d284346dd..8c35cab2b43 100644
---- a/hw/block/nvme.c
-+++ b/hw/block/nvme.c
-@@ -1201,7 +1201,7 @@ static const MemoryRegionOps nvme_cmb_ops = {
-     .write = nvme_cmb_write,
-     .endianness = DEVICE_LITTLE_ENDIAN,
-     .impl = {
--        .min_access_size = 2,
-+        .min_access_size = 1,
-         .max_access_size = 8,
-     },
- };
-diff --git a/tests/Makefile.include b/tests/Makefile.include
-index 613242bc6ef..fb0b449c02a 100644
---- a/tests/Makefile.include
-+++ b/tests/Makefile.include
-@@ -730,7 +730,7 @@ tests/test-hmp$(EXESUF): tests/test-hmp.o
- tests/machine-none-test$(EXESUF): tests/machine-none-test.o
- tests/drive_del-test$(EXESUF): tests/drive_del-test.o $(libqos-virtio-obj-y)
- tests/qdev-monitor-test$(EXESUF): tests/qdev-monitor-test.o $(libqos-pc-obj-y)
--tests/nvme-test$(EXESUF): tests/nvme-test.o
-+tests/nvme-test$(EXESUF): tests/nvme-test.o $(libqos-pc-obj-y)
- tests/pvpanic-test$(EXESUF): tests/pvpanic-test.o
- tests/i82801b11-test$(EXESUF): tests/i82801b11-test.o
- tests/ac97-test$(EXESUF): tests/ac97-test.o
-diff --git a/tests/nvme-test.c b/tests/nvme-test.c
-index 7674a446e4f..2700ba838aa 100644
---- a/tests/nvme-test.c
-+++ b/tests/nvme-test.c
-@@ -8,25 +8,73 @@
-  */
- 
- #include "qemu/osdep.h"
-+#include "qemu/units.h"
- #include "libqtest.h"
-+#include "libqos/libqos-pc.h"
-+
-+static QOSState *qnvme_start(const char *extra_opts)
-+{
-+    QOSState *qs;
-+    const char *arch = qtest_get_arch();
-+    const char *cmd = "-drive id=drv0,if=none,file=null-co://,format=raw "
-+                      "-device nvme,addr=0x4.0,serial=foo,drive=drv0 %s";
-+
-+    if (strcmp(arch, "i386") == 0 || strcmp(arch, "x86_64") == 0) {
-+        qs = qtest_pc_boot(cmd, extra_opts ? : "");
-+        global_qtest = qs->qts;
-+        return qs;
-+    }
-+
-+    g_printerr("nvme tests are only available on x86\n");
-+    exit(EXIT_FAILURE);
-+}
-+
-+static void qnvme_stop(QOSState *qs)
-+{
-+    qtest_shutdown(qs);
-+}
- 
--/* Tests only initialization so far. TODO: Replace with functional tests */
- static void nop(void)
- {
-+    QOSState *qs;
-+
-+    qs = qnvme_start(NULL);
-+    qnvme_stop(qs);
- }
- 
--int main(int argc, char **argv)
-+static void nvmetest_cmb_test(void)
- {
--    int ret;
-+    const int cmb_bar_size = 2 * MiB;
-+    QOSState *qs;
-+    QPCIDevice *pdev;
-+    QPCIBar bar;
- 
--    g_test_init(&argc, &argv, NULL);
--    qtest_add_func("/nvme/nop", nop);
-+    qs = qnvme_start("-global nvme.cmb_size_mb=2");
-+    pdev = qpci_device_find(qs->pcibus, QPCI_DEVFN(4,0));
-+    g_assert(pdev != NULL);
-+
-+    qpci_device_enable(pdev);
-+    bar = qpci_iomap(pdev, 2, NULL);
-+
-+    qpci_io_writel(pdev, bar, 0, 0xccbbaa99);
-+    g_assert_cmpint(qpci_io_readb(pdev, bar, 0), ==, 0x99);
-+    g_assert_cmpint(qpci_io_readw(pdev, bar, 0), ==, 0xaa99);
-+
-+    /* Test partially out-of-bounds accesses.  */
-+    qpci_io_writel(pdev, bar, cmb_bar_size - 1, 0x44332211);
-+    g_assert_cmpint(qpci_io_readb(pdev, bar, cmb_bar_size - 1), ==, 0x11);
-+    g_assert_cmpint(qpci_io_readw(pdev, bar, cmb_bar_size - 1), !=, 0x2211);
-+    g_assert_cmpint(qpci_io_readl(pdev, bar, cmb_bar_size - 1), !=, 0x44332211);
-+    g_free(pdev);
- 
--    qtest_start("-drive id=drv0,if=none,file=null-co://,format=raw "
--                "-device nvme,drive=drv0,serial=foo");
--    ret = g_test_run();
-+    qnvme_stop(qs);
-+}
- 
--    qtest_end();
-+int main(int argc, char **argv)
-+{
-+    g_test_init(&argc, &argv, NULL);
-+    qtest_add_func("/nvme/nop", nop);
-+    qtest_add_func("/nvme/cmb_test", nvmetest_cmb_test);
- 
--    return ret;
-+    return g_test_run();
- }
--- 
-2.19.2
-
diff --git a/gnu/packages/patches/qemu-CVE-2018-16867.patch b/gnu/packages/patches/qemu-CVE-2018-16867.patch
deleted file mode 100644
index 1403d8e0f8..0000000000
--- a/gnu/packages/patches/qemu-CVE-2018-16867.patch
+++ /dev/null
@@ -1,49 +0,0 @@
-Fix CVE-2018-16867:
-
-https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2018-16867
-https://seclists.org/oss-sec/2018/q4/202
-
-Patch copied from upstream source repository:
-
-https://git.qemu.org/?p=qemu.git;a=commitdiff;h=c52d46e041b42bb1ee6f692e00a0abe37a9659f6
-
-From c52d46e041b42bb1ee6f692e00a0abe37a9659f6 Mon Sep 17 00:00:00 2001
-From: Gerd Hoffmann <kraxel@redhat.com>
-Date: Mon, 3 Dec 2018 11:10:45 +0100
-Subject: [PATCH] usb-mtp: outlaw slashes in filenames
-MIME-Version: 1.0
-Content-Type: text/plain; charset=UTF-8
-Content-Transfer-Encoding: 8bit
-
-Slash is unix directory separator, so they are not allowed in filenames.
-Note this also stops the classic escape via "../".
-
-Fixes: CVE-2018-16867
-Reported-by: Michael Hanselmann <public@hansmi.ch>
-Signed-off-by: Gerd Hoffmann <kraxel@redhat.com>
-Reviewed-by: Philippe Mathieu-Daudé <philmd@redhat.com>
-Message-id: 20181203101045.27976-3-kraxel@redhat.com
----
- hw/usb/dev-mtp.c | 6 ++++++
- 1 file changed, 6 insertions(+)
-
-diff --git a/hw/usb/dev-mtp.c b/hw/usb/dev-mtp.c
-index 0f6a9702ef1..100b7171f4e 100644
---- a/hw/usb/dev-mtp.c
-+++ b/hw/usb/dev-mtp.c
-@@ -1719,6 +1719,12 @@ static void usb_mtp_write_metadata(MTPState *s)
- 
-     filename = utf16_to_str(dataset->length, dataset->filename);
- 
-+    if (strchr(filename, '/')) {
-+        usb_mtp_queue_result(s, RES_PARAMETER_NOT_SUPPORTED, d->trans,
-+                             0, 0, 0, 0);
-+        return;
-+    }
-+
-     o = usb_mtp_object_lookup_name(p, filename, dataset->length);
-     if (o != NULL) {
-         next_handle = o->handle;
--- 
-2.19.2
-
diff --git a/gnu/packages/patches/stumpwm-fix-broken-read-one-line.patch b/gnu/packages/patches/stumpwm-fix-broken-read-one-line.patch
new file mode 100644
index 0000000000..f8dac61307
--- /dev/null
+++ b/gnu/packages/patches/stumpwm-fix-broken-read-one-line.patch
@@ -0,0 +1,45 @@
+From a13db62a4da06426cf2eb2376d1a3723b5ee52d5 Mon Sep 17 00:00:00 2001
+From: Vasily Postnicov <shamaz.mazum@gmail.com>
+Date: Fri, 14 Dec 2018 20:01:53 +0300
+Subject: [PATCH] READ-ONE-LINE: Turn COMPLETIONS into a keyword argument
+
+This keeps READ-ONE-line backwards compatible to changes prior
+dae0422811771d179077b9336618f2b19be85b7b. Currently both
+ARGUMENT-POP-OR-READ and ARGUMENT-POP-REST-OR-READ are still being
+called with the previous lambda list. Update the calls to the
+READ-ONE-LINE that used the 'new' lambda list, COMPLETING-READ and
+YES-OR-NO-P.
+
+Closes #538
+---
+ input.lisp | 8 ++++++--
+ 1 file changed, 6 insertions(+), 2 deletions(-)
+
+diff --git a/input.lisp b/input.lisp
+index b698a368..7904b35f 100644
+--- a/input.lisp
++++ b/input.lisp
+@@ -307,10 +307,13 @@ passed the substring to complete on and is expected to return a list
+ of matches. If require-match argument is non-nil then the input must
+ match with an element of the completions."
+   (check-type completions (or list function symbol))
+-  (let ((line (read-one-line screen prompt completions :initial-input initial-input :require-match require-match)))
++  (let ((line (read-one-line screen prompt
++                             :completions completions
++                             :initial-input initial-input
++                             :require-match require-match)))
+     (when line (string-trim " " line))))
+ 
+-(defun read-one-line (screen prompt completions &key (initial-input "") require-match password)
++(defun read-one-line (screen prompt &key completions (initial-input "") require-match password)
+   "Read a line of input through stumpwm and return it. Returns nil if the user aborted."
+   (let ((*input-last-command* nil)
+         (*input-completions* completions)
+@@ -842,6 +845,7 @@ user presses 'y'"
+ user presses 'yes'"
+   (loop for line = (read-one-line (current-screen)
+                                   (format nil "~a(yes or no) " message)
++                                  :completions
+                                   '("yes" "no"))
+         until (find line '("yes" "no") :test 'string-equal)
+         do (message "Please answer yes or no")