changeset 5892:053ef01b71a8

Import the #'clear-string API from GNU, use it in tls.c src/ChangeLog addition: 2015-04-18 Aidan Kehoe <kehoea@parhasard.net> * sequence.c (Fclear_string): New, API from GNU. Zero a string's contents, making sure the text is not kept around even when the string's data is reallocated because of a changed character length. * sequence.c (syms_of_sequence): Make it available to Lisp. * lisp.h: Make it available to C code. * tls.c (nss_pk11_password): Use it. * tls.c (gnutls_pk11_password): Use it. * tls.c (openssl_password): Use it. tests/ChangeLog addition: 2015-04-18 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test #'clear-string, just added. Unfortunately there's no way to be certain from Lisp that the old password data has been erased after realloc; it may be worth adding a test to tests.c, but *we'll be reading memory we shouldn't be*, so that gives me pause.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 18 Apr 2015 23:00:14 +0100
parents 8704b7957585
children d3d073aceaea
files src/ChangeLog src/lisp.h src/sequence.c src/tls.c tests/ChangeLog tests/automated/lisp-tests.el
diffstat 6 files changed, 105 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sat Apr 11 18:34:14 2015 +0100
+++ b/src/ChangeLog	Sat Apr 18 23:00:14 2015 +0100
@@ -1,3 +1,15 @@
+2015-04-18  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* sequence.c (Fclear_string): New, API from GNU.  Zero a string's
+	contents, making sure the text is not kept around even when the
+	string's data is reallocated because of a changed character
+	length.
+	* sequence.c (syms_of_sequence): Make it available to Lisp.
+	* lisp.h: Make it available to C code.
+	* tls.c (nss_pk11_password): Use it.
+	* tls.c (gnutls_pk11_password): Use it.
+	* tls.c (openssl_password): Use it.
+
 2015-04-09  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* tls.c (nss_pk11_password):
--- a/src/lisp.h	Sat Apr 11 18:34:14 2015 +0100
+++ b/src/lisp.h	Sat Apr 18 23:00:14 2015 +0100
@@ -5788,6 +5788,7 @@
 
 /* Defined in sequence.c */
 EXFUN (Ffill, MANY);
+EXFUN (Fclear_string, 1);
 EXFUN (Freplace, MANY);
 
 /* Defined in signal.c */
--- a/src/sequence.c	Sat Apr 11 18:34:14 2015 +0100
+++ b/src/sequence.c	Sat Apr 18 23:00:14 2015 +0100
@@ -4154,6 +4154,52 @@
   return sequence;
 }
 
+DEFUN ("clear-string", Fclear_string, 1, 1, 0, /*
+Fill STRING with ?\\x00 characters.  Return nil.
+
+This differs from `fill' with a ?\\x00 argument in that it ensures that
+STRING's existing contents are discarded, even in the event of reallocation
+due to a change in the byte length of STRING.  In this implementation, the
+character length of STRING is not changed.
+*/
+       (string))
+{
+  Ibyte nullbyte[MAX_ICHAR_LEN];
+  Bytecount zerolen = set_itext_ichar (nullbyte, 0);
+  Charcount scount;
+
+  CHECK_STRING (string);
+
+  scount = string_char_length (string);
+
+  /* First, clear the original string data. */
+  memset (XSTRING_DATA (string), 0, XSTRING_LENGTH (string));
+
+  /* Now, resize if that's necessary, to make sure Lisp isn't confused by the
+     character length of a string changing. */
+  if (string_char_length (string) != scount)
+    {
+      Ibyte *p, *pend;
+      Bytecount delta = (zerolen * scount) - XSTRING_LENGTH (string);
+
+      resize_string (string, 0, delta);
+      p = XSTRING_DATA (string);
+      pend = p + XSTRING_LENGTH (string);
+
+      while (p < pend)
+        {
+          memcpy (p, nullbyte, zerolen);
+          p += zerolen;
+        }
+    }
+
+  init_string_ascii_begin (string);
+  bump_string_modiff (string);
+  sledgehammer_check_ascii_begin (string);
+
+  return Qnil;
+}
+
 
 /* Replace the substring of DEST beginning at START and ending before END
    with the text at SOURCE, which is END - START characters long and
@@ -8316,6 +8362,7 @@
   DEFSUBR (Fmerge);
   DEFSUBR (FsortX);
   DEFSUBR (Ffill);
+  DEFSUBR (Fclear_string);
   DEFSUBR (Fmapconcat);
   DEFSUBR (FmapcarX);
   DEFSUBR (Fmapvector);
--- a/src/tls.c	Sat Apr 11 18:34:14 2015 +0100
+++ b/src/tls.c	Sat Apr 18 23:00:14 2015 +0100
@@ -302,7 +302,7 @@
 static char *
 nss_pk11_password (PK11SlotInfo *slot, PRBool retry, void * UNUSED (arg))
 {
-  Lisp_Object lsp_password, args[2];
+  Lisp_Object lsp_password;
   Extbyte *c_password, *nss_password;
   const Extbyte *token_name;
 
@@ -319,10 +319,9 @@
   nss_password = PL_strdup (c_password);
 
   /* Wipe out the password on the stack and in the Lisp string */
-  args[0] = lsp_password;
-  args[1] = make_char ('*');
-  Ffill (2, args);
+  Fclear_string (lsp_password);
   memset (c_password, '*', strlen (c_password));
+
   return nss_password;
 }
 
@@ -729,10 +728,9 @@
   pin[len] = '\0';
 
   /* Wipe out the password on the stack and in the Lisp string */
-  args[0] = lsp_password;
-  args[1] = make_char ('*');
-  Ffill (2, args);
+  Fclear_string (lsp_password);
   memset (c_password, '*', strlen (c_password));
+
   return GNUTLS_E_SUCCESS;
 }
 
@@ -1075,7 +1073,7 @@
 openssl_password (char *buf, int size, int UNUSED (rwflag),
 		  void *UNUSED (userdata))
 {
-  Lisp_Object lsp_password, args[2];
+  Lisp_Object lsp_password;
   Extbyte *c_password;
 
   lsp_password =
@@ -1084,10 +1082,9 @@
   strncpy (buf, c_password, size);
 
   /* Wipe out the password on the stack and in the Lisp string */
-  args[0] = lsp_password;
-  args[1] = make_char ('*');
-  Ffill (2, args);
+  Fclear_string (lsp_password);
   memset (c_password, '*', strlen (c_password));
+
   return (int) strlen (buf);
 }
 
--- a/tests/ChangeLog	Sat Apr 11 18:34:14 2015 +0100
+++ b/tests/ChangeLog	Sat Apr 18 23:00:14 2015 +0100
@@ -3,6 +3,14 @@
 	* automated/lisp-tests.el:
 	Check for a bug just fixed in cl-macs.el.
 
+2015-04-18  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Test #'clear-string, just added. Unfortunately there's no way to
+	be certain from Lisp that the old password data has been erased
+	after realloc; it may be worth adding a test to tests.c, but
+	*we'll be reading memory we shouldn't be*, so that gives me pause.
+
 2015-04-08  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el	Sat Apr 11 18:34:14 2015 +0100
+++ b/tests/automated/lisp-tests.el	Sat Apr 18 23:00:14 2015 +0100
@@ -3796,6 +3796,35 @@
   (Assert (eql ?\x09 (digit-char 9 nil binary-table))
           "checking `digit-char' reflects RADIX-TABLE, 9, base 10"))
 
+;; Test #'clear-string.
+
+(Check-Error wrong-type-argument (clear-string [?\x00 ?\xff]))
+(Check-Error wrong-type-argument (clear-string '(?\x00 ?\xff)))
+(Check-Error wrong-type-argument (clear-string #*1010))
+(Check-Error wrong-number-of-arguments (clear-string "hello" ?*))
+
+(let* ((template (concat
+                  "this is a template string, "
+                  (if (unicode-to-char #x06af)
+                      (decode-coding-string
+                       (concat
+                        "\xd8\xa8\xd9\x87 \xd9\x86\xd8\xb8\xd8\xb1 "
+                        "\xd9\x85\xd9\x86 \xd8\xae\xd9\x88\xda\xa9 "
+                        "\xd8\xae\xd9\x88\xd8\xb4\xd9\x85\xd8\xb2\xd9\x87 "
+                        "\xd8\xa7\xd8\xb3\xd8\xaa")
+                       'utf-8))))
+       (length (length template))
+       (null (make-string length ?\x00)))
+  (Assert (null (clear-string (copy-sequence template))))
+  (Assert (eql length (let ((string (copy-sequence template)))
+                        (clear-string string)
+                        (length string))))
+  (Assert (equal null (let ((string (copy-sequence template)))
+                        (clear-string string)
+                        string))))
+
+;; No way to check from Lisp whether the data was actually nulled.
+
 ;; Check that a bug in #'check-type with non-setfable PLACE (something not
 ;; actually specified by Common Lisp) has been fixed.
 (Assert (prog1 t (check-type 300 fixnum))