Subject: bug#19438: 24.4; system-name bad cache

From: Paul Eggert <[email-masked]>
Date: Fri, 26 Dec 2014 08:07:55 -0800

Unfortunately even "the name of the machine" can change; e.g., I can invoke the 
shell command "hostname garfield" to change my machine's name to garfield. 
Also, I expect that if Emacs has its process migrated (LinuxPMI, anybody?) it 
will then be running on a different machine with a different name.

How about the attached patch?  The idea is that (system-name) actually inquires 
for the current system name, and system-name caches the result.  If an Emacs 
lisp program assigns to system-name, though, it's no longer updated thereafter.
>From 4e356e24a95792ffd2b27f0098792cda269b867a Mon Sep 17 00:00:00 2001
From: Paul Eggert <[email-masked]>
Date: Fri, 26 Dec 2014 07:57:50 -0800
Subject: [PATCH] system-name's returned value can vary

Fixes Bug#19438.
* doc/lispref/os.texi (System Environment):
* etc/NEWS: Document this.
* doc/misc/efaq.texi:
(Displaying the current file name in the titlebar):
* lisp/desktop.el (desktop-save-frameset):
* lisp/dnd.el (dnd-get-local-file-uri):
* lisp/gnus/nnvirtual.el (nnvirtual-retrieve-headers)
(nnvirtual-update-xref-header):
* lisp/nxml/rng-uri.el (rng-uri-file-name-1):
* lisp/org/org-clock.el (org-clock-save):
* src/filelock.c (current_lock_owner):
* src/xrdb.c (get_environ_db):
* src/xterm.c (same_x_server):
* src/xterm.c (x_term_init):
Prefer (system-name) to system-name.
* doc/misc/smtpmail.texi (Server workarounds): Fix grammar.
* src/editfns.c (cached_system_name): New static var.
(init_and_cache_system_name): New function.
(init_editfns, Fsystem_name): Use it.
(syms_of_editfns): Initialize it and Vsystem_name to the same value.
* src/sysdep.c (init_system_name): Don't create a new string if
the current value is already correct.
---
 ChangeLog              | 27 +++++++++++++++++++++++++++
 doc/lispref/os.texi    |  9 +++++++--
 doc/misc/efaq.texi     |  2 +-
 doc/misc/smtpmail.texi |  2 +-
 etc/NEWS               |  3 +++
 lisp/desktop.el        |  2 +-
 lisp/dnd.el            | 21 +++++++++++----------
 lisp/gnus/nnvirtual.el |  4 ++--
 lisp/nxml/rng-uri.el   |  2 +-
 lisp/org/org-clock.el  |  4 ++--
 src/editfns.c          | 16 +++++++++++++++-
 src/filelock.c         |  7 ++++---
 src/sysdep.c           | 23 ++++++++++++-----------
 src/xrdb.c             |  5 +++--
 src/xterm.c            | 12 +++++++-----
 15 files changed, 97 insertions(+), 42 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 90d7c0b..fd24995 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,30 @@
+2014-12-26  Paul Eggert  <[email-masked]>
+
+	system-name's returned value can vary
+	Fixes Bug#19438.
+	* doc/lispref/os.texi (System Environment):
+	* etc/NEWS: Document this.
+	* doc/misc/efaq.texi:
+	(Displaying the current file name in the titlebar):
+	* lisp/desktop.el (desktop-save-frameset):
+	* lisp/dnd.el (dnd-get-local-file-uri):
+	* lisp/gnus/nnvirtual.el (nnvirtual-retrieve-headers)
+	(nnvirtual-update-xref-header):
+	* lisp/nxml/rng-uri.el (rng-uri-file-name-1):
+	* lisp/org/org-clock.el (org-clock-save):
+	* src/filelock.c (current_lock_owner):
+	* src/xrdb.c (get_environ_db):
+	* src/xterm.c (same_x_server):
+	* src/xterm.c (x_term_init):
+	Prefer (system-name) to system-name.
+	* doc/misc/smtpmail.texi (Server workarounds): Fix grammar.
+	* src/editfns.c (cached_system_name): New static var.
+	(init_and_cache_system_name): New function.
+	(init_editfns, Fsystem_name): Use it.
+	(syms_of_editfns): Initialize it and Vsystem_name to the same value.
+	* src/sysdep.c (init_system_name): Don't create a new string if
+	the current value is already correct.
+
 2014-12-25  Paul Eggert  <[email-masked]>
 
 	Prefer stpcpy to strcat
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index b709447..72d1ec7 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -918,10 +918,15 @@ string.
 @end defun
 
   The symbol @code{system-name} is a variable as well as a function.  In
-fact, the function returns whatever value the variable
+fact, the function normally returns whatever value the variable
 @code{system-name} currently holds.  Thus, you can set the variable
 @code{system-name} in case Emacs is confused about the name of your
-system.  The variable is also useful for constructing frame titles
+system.  If you do not set the variable, the function updates
+the variable to the current system name; this behavior can be useful
+if your Emacs process has changed systems or if the system has changed
+names.
+
+The @code{system-name} variable is also useful for constructing frame titles
 (@pxref{Frame Titles}).
 
 @c FIXME seems like this section is not the best place for this option?
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 0159101..71c5ae0 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -1469,7 +1469,7 @@ machine at which Emacs was invoked.  This is done by setting
 @code{frame-title-format} to the default value of
 
 @lisp
-(multiple-frames "%b" ("" invocation-name "@@" system-name))
+(multiple-frames "%b" ("" invocation-name "@@" (system-name)))
 @end lisp
 
 To modify the behavior such that frame titlebars contain the buffer's
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index f539cd0..9cddbfa 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -368,7 +368,7 @@ implement support for common requirements.
 @vindex smtpmail-local-domain
   The variable @code{smtpmail-local-domain} controls the hostname sent
 in the first @code{EHLO} or @code{HELO} command sent to the server.
-It should only be set if the @code{system-name} function returns a
+It should be set only if the @code{system-name} function returns a
 name that isn't accepted by the server.  Do not set this variable
 unless your server complains.
 
diff --git a/etc/NEWS b/etc/NEWS
index 14933aa..03fc0ed 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -533,6 +533,9 @@ optional repeat-count argument.
 
 ** Function `sort' can deal with vectors.
 
+** Function `system-name' now returns an updated value if the current
+system's name has changed, or if the Emacs process has changed systems.
+
 ---
 ** New utilities in subr-x.el:
 *** New macros `if-let' and `when-let' allow defining bindings and to
diff --git a/lisp/desktop.el b/lisp/desktop.el
index bad0073..bcf0387 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -940,7 +940,7 @@ Frames with a non-nil `desktop-dont-save' parameter are not saved."
 	(and desktop-restore-frames
 	     (frameset-save nil
 			    :app desktop--app-id
-			    :name (concat user-login-name "@" system-name)
+			    :name (concat user-login-name "@" (system-name))
 			    :predicate #'desktop--check-dont-save))))
 
 ;;;###autoload
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 73b531d..2b68b02 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -122,17 +122,18 @@ Return nil if URI is not a local file."
 
   ;; The hostname may be our hostname, in that case, convert to a local
   ;; file.  Otherwise return nil.  TODO:  How about an IP-address as hostname?
-  (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
+  (let ((system-name (system-name)))
+    (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
 		      (downcase (match-string 1 uri))))
-	(system-name-no-dot
-	 (downcase (if (string-match "^[^\\.]+" system-name)
-		       (match-string 0 system-name)
-		     system-name))))
-    (when (and hostname
-	     (or (string-equal "localhost" hostname)
-		 (string-equal (downcase system-name) hostname)
-		 (string-equal system-name-no-dot hostname)))
-	(concat "file://" (substring uri (+ 7 (length hostname)))))))
+	  (system-name-no-dot
+	   (downcase (if (string-match "^[^\\.]+" system-name)
+			 (match-string 0 system-name)
+		       system-name))))
+      (when (and hostname
+		 (or (string-equal "localhost" hostname)
+		     (string-equal (downcase system-name) hostname)
+		     (string-equal system-name-no-dot hostname)))
+	(concat "file://" (substring uri (+ 7 (length hostname))))))))
 
 (defsubst dnd-unescape-uri (uri)
   (replace-regexp-in-string
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index f67943a..d13b492 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -151,7 +151,7 @@ component group will show up when you enter the virtual group.")
 		  ;; and clean up the xrefs.
 		  (princ article nntp-server-buffer)
 		  (nnvirtual-update-xref-header cgroup carticle
-						prefix system-name)
+						prefix (system-name))
 		  (forward-line 1))
 		)
 
@@ -393,7 +393,7 @@ component group will show up when you enter the virtual group.")
     (forward-char -1)
     (delete-char 1))
 
-  (insert "Xref: " system-name " " group ":")
+  (insert "Xref: " (system-name) " " group ":")
   (princ article (current-buffer))
   (insert " ")
 
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index b93624a..43218ec 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -85,7 +85,7 @@ Signal an error if URI is not a valid file URL."
 	  ((not (string= (downcase scheme) "file"))
 	   (rng-uri-error "URI `%s' does not use the `file:' scheme" uri)))
     (when (not (member authority
-		       (cons system-name '(nil "" "localhost"))))
+		       (cons (system-name) '(nil "" "localhost"))))
       (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'"
 	     uri))
     (when query
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 51c8789..c928758 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -2811,8 +2811,8 @@ The details of what will be saved are regulated by the variable
 	  (delete-region (point-min) (point-max))
 	  ;;Store clock
 	  (insert (format ";; org-persist.el - %s at %s\n"
-			  system-name (format-time-string
-				       (cdr org-time-stamp-formats))))
+			  (system-name) (format-time-string
+					 (cdr org-time-stamp-formats))))
 	  (if (and (memq org-clock-persist '(t clock))
 		   (setq b (org-clocking-buffer))
 		   (setq b (or (buffer-base-buffer b) b))
diff --git a/src/editfns.c b/src/editfns.c
index 430c4c9..2a7dd92 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -93,6 +93,17 @@ static char const *initial_tz;
    It is OK (though a bit slower) if the user chooses this value.  */
 static char dump_tz_string[] = "TZ=UtC0";
 
+/* The cached value of Vsystem_name.  This is used only to compare it
+   to Vsystem_name, so it need not be visible to the GC.  */
+static Lisp_Object cached_system_name;
+
+static void
+init_and_cache_system_name (void)
+{
+  init_system_name ();
+  cached_system_name = Vsystem_name;
+}
+
 void
 init_editfns (void)
 {
@@ -102,7 +113,7 @@ init_editfns (void)
   Lisp_Object tem;
 
   /* Set up system_name even when dumping.  */
-  init_system_name ();
+  init_and_cache_system_name ();
 
 #ifndef CANNOT_DUMP
   /* When just dumping out, set the time zone to a known unlikely value
@@ -1365,6 +1376,8 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
        doc: /* Return the host name of the machine you are running on, as a string.  */)
   (void)
 {
+  if (EQ (Vsystem_name, cached_system_name))
+    init_and_cache_system_name ();
   return Vsystem_name;
 }
 
@@ -4965,6 +4978,7 @@ functions if all the text being accessed has this property.  */);
 
   DEFVAR_LISP ("system-name", Vsystem_name,
 	       doc: /* The host name of the machine Emacs is running on.  */);
+  Vsystem_name = cached_system_name = Qnil;
 
   DEFVAR_LISP ("user-full-name", Vuser_full_name,
 	       doc: /* The full name of the user logged in.  */);
diff --git a/src/filelock.c b/src/filelock.c
index f857c48..99215f2 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -592,9 +592,10 @@ current_lock_owner (lock_info_type *owner, char *lfname)
     return -1;
 
   /* On current host?  */
-  if (STRINGP (Vsystem_name)
-      && dot - (at + 1) == SBYTES (Vsystem_name)
-      && memcmp (at + 1, SSDATA (Vsystem_name), SBYTES (Vsystem_name)) == 0)
+  Lisp_Object system_name = Fsystem_name ();
+  if (STRINGP (system_name)
+      && dot - (at + 1) == SBYTES (system_name)
+      && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0)
     {
       if (pid == getpid ())
         ret = 2; /* We own it.  */
diff --git a/src/sysdep.c b/src/sysdep.c
index 24cc5cb..b4a9be1 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1420,15 +1420,16 @@ extern int h_errno;
 void
 init_system_name (void)
 {
+  char *hostname_alloc = NULL;
+  char *hostname;
 #ifndef HAVE_GETHOSTNAME
   struct utsname uts;
   uname (&uts);
-  Vsystem_name = build_string (uts.nodename);
+  hostname = uts.nodename;
 #else /* HAVE_GETHOSTNAME */
-  char *hostname_alloc = NULL;
   char hostname_buf[256];
   ptrdiff_t hostname_size = sizeof hostname_buf;
-  char *hostname = hostname_buf;
+  hostname = hostname_buf;
 
   /* Try to get the host name; if the buffer is too short, try
      again.  Apparently, the only indication gethostname gives of
@@ -1541,15 +1542,15 @@ init_system_name (void)
 #endif /* !HAVE_GETADDRINFO */
       }
 #endif /* HAVE_SOCKETS */
-  Vsystem_name = build_string (hostname);
-  xfree (hostname_alloc);
 #endif /* HAVE_GETHOSTNAME */
-  {
-    char *p;
-    for (p = SSDATA (Vsystem_name); *p; p++)
-      if (*p == ' ' || *p == '\t')
-	*p = '-';
-  }
+  char *p;
+  for (p = hostname; *p; p++)
+    if (*p == ' ' || *p == '\t')
+      *p = '-';
+  if (! (STRINGP (Vsystem_name) && SBYTES (Vsystem_name) == p - hostname
+	 && strcmp (SSDATA (Vsystem_name), hostname) == 0))
+    Vsystem_name = build_string (hostname);
+  xfree (hostname_alloc);
 }
 
 sigset_t empty_mask;
diff --git a/src/xrdb.c b/src/xrdb.c
index e21206d..8500fb1 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -385,10 +385,11 @@ get_environ_db (void)
     {
       char *home = gethomedir ();
       ptrdiff_t homelen = strlen (home);
+      Lisp_Object system_name = Fsystem_name ();
       ptrdiff_t filenamesize = (homelen + sizeof xdefaults
-				+ SBYTES (Vsystem_name));
+				+ SBYTES (system_name));
       p = filename = xrealloc (home, filenamesize);
-      lispstpcpy (stpcpy (filename + homelen, xdefaults), Vsystem_name);
+      lispstpcpy (stpcpy (filename + homelen, xdefaults), system_name);
     }
 
   db = XrmGetFileDatabase (p);
diff --git a/src/xterm.c b/src/xterm.c
index 0640208..cbd8bf1 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10501,8 +10501,9 @@ static bool
 same_x_server (const char *name1, const char *name2)
 {
   bool seen_colon = false;
-  const char *system_name = SSDATA (Vsystem_name);
-  ptrdiff_t system_name_length = SBYTES (Vsystem_name);
+  Lisp_Object sysname = Fsystem_name ();
+  const char *system_name = SSDATA (sysname);
+  ptrdiff_t system_name_length = SBYTES (sysname);
   ptrdiff_t length_until_period = 0;
 
   while (system_name[length_until_period] != 0
@@ -10894,14 +10895,15 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
 #endif
 
   lim = min (PTRDIFF_MAX, SIZE_MAX) - sizeof "@";
-  if (lim - SBYTES (Vinvocation_name) < SBYTES (Vsystem_name))
+  Lisp_Object system_name = Fsystem_name ();
+  if (lim - SBYTES (Vinvocation_name) < SBYTES (system_name))
     memory_full (SIZE_MAX);
   dpyinfo->x_id = ++x_display_id;
   dpyinfo->x_id_name = xmalloc (SBYTES (Vinvocation_name)
-				+ SBYTES (Vsystem_name) + 2);
+				+ SBYTES (system_name) + 2);
   char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name);
   *nametail++ = '@';
-  lispstpcpy (nametail, Vsystem_name);
+  lispstpcpy (nametail, system_name);
 
   /* Figure out which modifier bits mean what.  */
   x_find_modifier_meanings (dpyinfo);
-- 
1.9.3