Mercurial > hg > xemacs-beta
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))