bug#54263: 29.0.50; color-values-from-color-spec accepts whitespace in rgbi: specifications

[Philip Kaludercic]

I am not certain if this is intended, but the "rgbi:" specifications
appear to tolerate whitespace

       (color-values-from-color-spec "rgbi:0/0/ 0")

despite not being documented.  From what I see, the issue stems from
parse_float_color_comp calling strtod, where strtod(3) says:

       The  expected  form of the (initial portion of the) string is op‐
       tional leading white space as recognized by  isspace(3) [...]

If this is considered to be an issue (I'd argue that relying a detail of
this kind in the libc could lead to problem), something like this could
solve the issue:

diff --git a/src/xfaces.c b/src/xfaces.c
index cf155288bd..308509a026 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -220,6 +220,7 @@ Copyright (C) 1993-1994, 1998-2020 Free Software 
Foundation, Inc.
 #include "sysstdio.h"
 #include <sys/types.h>
 #include <sys/stat.h>
+#include <math.h>
 
 #include "lisp.h"
 #include "character.h"
@@ -819,6 +820,120 @@ load_pixmap (struct frame *f, Lisp_Object name)
                             Color Handling
  ***********************************************************************/
 
+/* Parse hex color component at S ending right before E.
+   Set *DST to the value normalized so that the maximum for the
+   number of digits given becomes 65535, and return true on success,
+   false otherwise.  */
+static bool
+parse_hex_color_comp (const char *s, const char *e, unsigned short *dst)
+{
+  int n = e - s;
+  if (n <= 0 || n > 4)
+    return false;
+  int val = 0;
+  for (; s < e; s++)
+    {
+      int digit;
+      if (*s >= '0' && *s <= '9')
+        digit = *s - '0';
+      else if (*s >= 'A' && *s <= 'F')
+        digit = *s - 'A' + 10;
+      else if (*s >= 'a' && *s <= 'f')
+        digit = *s - 'a' + 10;
+      else
+        return false;
+      val = (val << 4) | digit;
+    }
+  int maxval = (1 << (n * 4)) - 1;
+  *dst = (unsigned)val * 65535 / maxval;
+  return true;
+}
+
+/* Parse floating-point color component at S ending right before E.
+   Return the number if in the range [0,1]; otherwise -1.  */
+static double
+parse_float_color_comp (const char *s, const char *e)
+{
+  char *end;
+  double x = strtod (s, &end);
+  return (end == e && x >= 0 && x <= 1) ? x : -1;
+}
+
+/* Parse S as a numeric color specification and set *R, *G and *B.
+   Return true on success, false on failure.
+   Recognized formats:
+
+    "#RGB", with R, G and B hex strings of equal length, 1-4 digits each
+    "rgb:R/G/B", with R, G and B hex strings, 1-4 digits each
+    "rgbi:R/G/B", with R, G and B numbers in [0,1]
+
+   The result is normalized to a maximum value of 65535 per component.  */
+bool
+parse_color_spec (const char *s,
+                  unsigned short *r, unsigned short *g, unsigned short *b)
+{
+  int len = strlen (s);
+  if (s[0] == '#')
+    {
+      if ((len - 1) % 3 == 0)
+        {
+          int n = (len - 1) / 3;
+          return (   parse_hex_color_comp (s + 1 + 0 * n, s + 1 + 1 * n, r)
+                  && parse_hex_color_comp (s + 1 + 1 * n, s + 1 + 2 * n, g)
+                  && parse_hex_color_comp (s + 1 + 2 * n, s + 1 + 3 * n, b));
+        }
+    }
+  else if (strncmp (s, "rgb:", 4) == 0)
+    {
+      char *sep1, *sep2;
+      return ((sep1 = strchr (s + 4, '/')) != NULL
+              && (sep2 = strchr (sep1 + 1, '/')) != NULL
+              && parse_hex_color_comp (s + 4, sep1, r)
+              && parse_hex_color_comp (sep1 + 1, sep2, g)
+              && parse_hex_color_comp (sep2 + 1, s + len, b));
+    }
+  else if (strncmp (s, "rgbi:", 5) == 0)
+    {
+      char *sep1, *sep2;
+      double red, green, blue;
+      if ((sep1 = strchr (s + 5, '/')) != NULL
+          && (sep2 = strchr (sep1 + 1, '/')) != NULL
+          && (red = parse_float_color_comp (s + 5, sep1)) >= 0
+          && (green = parse_float_color_comp (sep1 + 1, sep2)) >= 0
+          && (blue = parse_float_color_comp (sep2 + 1, s + len)) >= 0)
+        {
+          *r = lrint (red * 65535);
+          *g = lrint (green * 65535);
+          *b = lrint (blue * 65535);
+          return true;
+        }
+    }
+  return false;
+}
+
+DEFUN ("internal-color-values-from-color-spec",
+       Finternal_color_values_from_color_spec,
+       Sinternal_color_values_from_color_spec,
+       1, 1, 0,
+       doc: /* Parse STRING as a numeric color and return (RED GREEN BLUE).
+Recognised formats for STRING are:
+
+ #RGB, where R, G and B are hex numbers of equal length, 1-4 digits each
+ rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each
+ rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1]
+
+The result is normalized to a maximum value of 65535 per component,
+forming a list of three integers in [0,65535].
+If STRING is not in one of the above forms, return nil.  */)
+  (Lisp_Object string)
+{
+  CHECK_STRING (string);
+  unsigned short r, g, b;
+  return (parse_color_spec (SSDATA (string), &r, &g, &b)
+          ? list3i (r, g, b)
+          : Qnil);
+}
+
 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
    RGB_LIST should contain (at least) 3 lisp integers.
    Return true iff RGB_LIST is OK.  */
@@ -7018,4 +7133,5 @@ syms_of_xfaces (void)
   defsubr (&Sinternal_face_x_get_resource);
   defsubr (&Sx_family_fonts);
 #endif
+  defsubr (&Sinternal_color_values_from_color_spec);
 }

In GNU Emacs 29.0.50 (build 13, x86_64-pc-linux-gnu, GTK+ Version 3.24.30, 
cairo version 1.16.0)
 of 2022-02-24 built on viero
Repository revision: bd17fa2c7565f180cedbfa396c0b159e144178cb
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LIBOTF LIBXML2 M17N_FLT MODULES NOTIFY INOTIFY PDUMPER PNG RSVG
SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS X11 XDBE XIM XPM
GTK3 ZLIB

Important settings:
  value of $EMACSLOADPATH: 
  value of $LANG: en_US.utf8
  locale-coding-system: utf-8-unix

Major mode: ELisp/l

Minor modes in effect:
  TeX-PDF-mode: t
  rcirc-track-minor-mode: t
  global-git-commit-mode: t
  magit-auto-revert-mode: t
  auto-revert-mode: t
  shell-dirtrack-mode: t
  outline-minor-mode: t
  corfu-mode: t
  flymake-mode: t
  flyspell-mode: t
  recentf-mode: t
  repeat-mode: t
  display-battery-mode: t
  display-time-mode: t
  diff-hl-flydiff-mode: t
  diff-hl-mode: t
  winner-mode: t
  windmove-mode: t
  electric-pair-mode: t
  save-place-mode: t
  savehist-mode: t
  xterm-mouse-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tab-bar-mode: t
  file-name-shadow-mode: t
  context-menu-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  temp-buffer-resize-mode: t
  line-number-mode: t
  transient-mark-mode: t
  auto-save-visited-mode: t

Load-path shadows:
/home/philip/Source/sp-tutor/sp-tutor hides 
/home/philip/.config/emacs/site-lisp/sp-tutor/sp-tutor
/home/philip/Source/sp-tutor/waffel hides 
/home/philip/.config/emacs/site-lisp/sp-tutor/waffel
/home/philip/.config/emacs/elpa/transient-0.3.7/transient hides 
/home/philip/Source/emacs/lisp/transient
~/.config/emacs/site-lisp/autoload hides 
/home/philip/Source/emacs/lisp/emacs-lisp/autoload

Features:
(shadow emacsbug pcmpl-unix reposition tabify man preview tex-buf
tex-fold reftex-dcr reftex-auc reftex reftex-loaddefs reftex-vars
font-latex latex latex-flymake tex-ispell tex-style tex texmathp
tex-mode latexenc cl-print slime-tests ert debug backtrace slime gud
apropos arc-mode archive-mode hyperspec cl compat-macs org-element
avl-tree ol-eww eww xdg url-queue mm-url ol-rmail ol-mhe ol-irc ol-info
ol-gnus nnselect ol-docview ol-bibtex ol-bbdb ol-w3m ol-doi org-link-doi
org ob ob-tangle ob-ref ob-lob ob-table ob-exp org-macro org-footnote
org-src ob-comint org-pcomplete org-list org-faces org-entities
org-version ob-emacs-lisp ob-core ob-eval org-table oc-basic bibtex ol
org-keys oc org-compat org-macs org-loaddefs cal-menu calendar
cal-loaddefs goto-addr shortdoc avy ffap grep mm-archive url-http url-gw
url-cache url-auth cus-edit finder-inf autoconf autoconf-mode whitespace
geiser-mode geiser-xref geiser-guile info-look geiser geiser-repl
geiser-compile geiser-debug geiser-image geiser-company geiser-doc
geiser-menu geiser-edit etags fileloop generator geiser-completion
geiser-autodoc advice geiser-eval geiser-connection tq geiser-syntax
geiser-log geiser-popup view scheme modus-vivendi-theme markdown-mode
ibuffer ibuffer-loaddefs rcirc find-dired shell-command+ doc-view
jka-compr image-mode exif pulse color find-func xref wdired flymake-cc
cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine
cc-vars cc-defs make-mode char-fold misearch multi-isearch dired-aux
gnus-dired pp vc-mtn vc-bzr vc-src vc-sccs vc-svn vc-cvs vc-rcs
bug-reference magit-ediff ediff ediff-merg ediff-mult ediff-wind
ediff-diff ediff-help ediff-init ediff-util magit-extras mule-util
magit-submodule magit-obsolete magit-blame magit-stash magit-reflog
magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote
magit-commit magit-sequence magit-notes magit-worktree magit-tag
magit-merge magit-branch magit-reset magit-files magit-refs magit-status
magit magit-repos magit-apply magit-wip magit-log which-func imenu
magit-diff smerge-mode git-commit log-edit add-log magit-core
magit-autorevert autorevert filenotify magit-margin magit-transient
magit-process with-editor shell pcomplete server magit-mode transient
edmacro kmacro magit-git magit-section benchmark magit-utils crm dash
cus-start mailalias smtpmail autocrypt-message ecomplete sort smiley
gnus-cite mail-extr textsec uni-scripts idna-mapping ucs-normalize
uni-confusable textsec-check gnus-bcklg qp copyright vc-backup log-view
pcvs-util vc-fossil time-stamp gnus-async gnus-ml autocrypt-gnus
autocrypt nndraft nnmh utf-7 nnfolder epa-file gnutls network-stream nsm
gnus-agent gnus-srvr gnus-score score-mode nnvirtual gnus-msg gnus-art
mm-uu mml2015 mm-view mml-smime smime dig nntp gnus-cache gnus-sum shr
pixel-fill kinsoku url-file url-dired svg dom gnus-group gnus-undo
gnus-start gnus-dbus gnus-cloud nnimap nnmail mail-source utf7 netrc
nnoo parse-time iso8601 gnus-spec gnus-int gnus-range message yank-media
rmc puny rfc822 mml mml-sec epa derived epg rfc6068 epg-config mm-decode
mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader
gnus-win cl-extra noutline outline corfu checkdoc flymake-proc flymake
project warnings thingatpt flyspell ispell auth-source-pass recentf
tree-widget repeat pcase format-spec battery dbus xml dired-x dired
dired-loaddefs time sendmail rfc2047 rfc2045 ietf-drums gnus nnheader
gnus-util time-date mail-utils range mm-util mail-prsvr wid-edit
help-at-pt diff-hl-flydiff diff diff-hl face-remap vc-hg vc-git vc-dir
ewoc vc vc-dispatcher diff-mode easy-mmode hippie-exp winner windmove rx
elec-pair saveplace savehist xt-mouse modus-operandi-theme modus-themes
rot13 disp-table cus-load setup compile text-property-search comint
ansi-color autoload lisp-mnt tex-site geiser-impl help-fns radix-tree
help-mode geiser-custom geiser-base ring slime-autoloads info package
browse-url url url-proxy url-privacy url-expand url-methods url-history
url-cookie url-domsuf url-util mailcap url-handlers url-parse
auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json map url-vars seq gv subr-x byte-opt bytecomp
byte-compile cconv cl-loaddefs cl-lib iso-transl tooltip eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite emoji-zwj charscript charprop case-table
epa-hook jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice
button loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 16 1276046 170560)
 (symbols 48 52054 48)
 (strings 32 214741 20363)
 (string-bytes 1 6381398)
 (vectors 16 115056)
 (vector-slots 8 2265569 122894)
 (floats 8 774 827)
 (intervals 56 36636 4853)
 (buffers 992 113))

-- 
        Philip Kaludercic