🚀 go-pugleaf

    I have noticed that when the lock file is checked, emacs checks that
    the process with the pid given in the lock file is running on that
    machine.  This obviously falls down when we have a number of machines
    accessing the same file over NFS.

I've written a patch for this.  The basic idea is to use a symlink named
`.#foo', pointing to `user@host.pid', to lock a file foo. (Symlinks for
efficiency.)  The comment at the top explains further.  The comment in
for the editfns.c patch explains why it's needed, too.

A similar patch applies to Emacs 18.  I can give that to anyone who
wants it.  I've installed this on SunOS 4.x, Solaris 2.x, HPUX [89].x,
IRIX [45].x, Ultrix 4.3, Alpha OSF/1 {1.3,2.0}, DG/UX 5.4.2, Linux
1.0.4, RS/6000 AIX 3.2.4, and probably other systems I'm forgetting now.

There are two main pieces left unimplemented:
1) making it work for systems without symbolic links (you just have to
   create regular files, or fall back to the present scheme);
2) writing a daemon to check for obsolete lock files.
You can search for `xx' in the patch to see the places where work needs
to be done for this.

I'm not likely to ever have time to write these parts, but I hope
someone else will.

Richard, I think I already sent you papers from Interleaf that cover
this (and everything else). If I haven't, please tell me so I can.


*** ./ORIG/filelock.c	Tue May  3 22:30:14 1994
--- ./filelock.c	Mon Oct  3 20:07:37 1994
*************** along with GNU Emacs; see the file COPYI
*** 17,21 ****
  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  
- 
  #include <sys/types.h>
  #include <sys/stat.h>
--- 17,20 ----
*************** the Free Software Foundation, 675 Mass A
*** 35,140 ****
  
  #include "lisp.h"
- #include <paths.h>
  #include "buffer.h"
  
- #ifdef SYSV_SYSTEM_DIR
- #include <dirent.h>
- #else /* not SYSV_SYSTEM_DIR */
- #ifdef NONSYSTEM_DIR_LIBRARY
- #include "ndir.h"
- #else /* not NONSYSTEM_DIR_LIBRARY */
- #ifdef MSDOS
- #include <dirent.h>
- #else
- #include <sys/dir.h>
- #endif
- #endif /* not NONSYSTEM_DIR_LIBRARY */
- #ifndef MSDOS
- extern DIR *opendir ();
- #endif /* not MSDOS */
- #endif /* not SYSV_SYSTEM_DIR */
- 
  extern int errno;
  
- extern char *egetenv ();
- extern char *strcpy ();
- 
- #if defined (__bsdi__) || defined (DECLARE_GETPWUID_WITH_UID_T)
- extern struct passwd *getpwuid (uid_t);
- #else
- extern struct passwd *getpwuid ();
- #endif
- 
  #ifdef CLASH_DETECTION
    
! /* If system does not have symbolic links, it does not have lstat.
!    In that case, use ordinary stat instead.  */
! 
! #ifndef S_IFLNK
! #define lstat stat
! #endif
! 
! 
! /* The name of the directory in which we keep lock files, with a '/'
!    appended.  */  
! char *lock_path;
! 
! /* The name of the file in the lock directory which is used to
!    arbitrate access to the entire directory.  */
! #define SUPERLOCK_NAME "!!!SuperLock!!!"
! 
! /* The path to the superlock file.  This is SUPERLOCK_NAME appended to
!    lock_path.  */
! char *superlock_path;
! 
! /* Set LOCK to the name of the lock file for the filename FILE.
!    char *LOCK; Lisp_Object FILE;  */
! 
! #ifndef HAVE_LONG_FILE_NAMES
  
  #define MAKE_LOCK_PATH(lock, file) \
!   (lock = (char *) alloca (14 + strlen (lock_path) + 1), \
!    fill_in_lock_short_file_name (lock, (file)))
! 
! 
! fill_in_lock_short_file_name (lockfile, fn)
!      register char *lockfile;
!      register Lisp_Object fn;
! {
!   register union
!     {
!       unsigned int  word [2];
!       unsigned char byte [8];
!     } crc;
!   register unsigned char *p, new;
!   
!   /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
!      the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
! 
!   crc.word[0] = crc.word[1] = 0;
! 
!   for (p = XSTRING (fn)->data; new = *p++; )
!     {
!       new += crc.byte[6];
!       crc.byte[6] = crc.byte[5] + new;
!       crc.byte[5] = crc.byte[4];
!       crc.byte[4] = crc.byte[3];
!       crc.byte[3] = crc.byte[2] + new;
!       crc.byte[2] = crc.byte[1];
!       crc.byte[1] = crc.byte[0];
!       crc.byte[0] = new;
!     }
!   sprintf (lockfile, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_path,
! 	   crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3],
! 	   crc.byte[4], crc.byte[5], crc.byte[6]);
! }
! 
! #else /* defined HAVE_LONG_FILE_NAMES */
! 
! #define MAKE_LOCK_PATH(lock, file) \
!   (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_path) + 1), \
     fill_in_lock_file_name (lock, (file)))
  
! 
  fill_in_lock_file_name (lockfile, fn)
       register char *lockfile;
--- 34,93 ----
  
  #include "lisp.h"
  #include "buffer.h"
  
  extern int errno;
  
  #ifdef CLASH_DETECTION
    
! /* The strategy: to lock a file FN, create a symlink .#FN in FN's
!    directory, with link data `user@host.pid'.  This avoids a single
!    mount (== failure) point for lock files.
! 
!    When the host in the lock data is the current host, we can check if
!    the pid is valid with kill.  Otherwise, we look at a separate file
!    that maps hostnames to reboot times to see if the remote pid can
!    possibly be valid.
!    
!    We don't want Emacs to have to communicate via pipes or sockets or
!    whatever to other processes, either locally or remotely; rms says
!    that's too unreliable.  Hence the separate file, which could
!    theoretically be updated by daemons running separately -- but this is
!    unimplemented.
!    
!    We use symlinks instead of normal files because (1) they are likely
!    to be stored much more efficiently on the filesystem (the kernel
!    knows they will be small), and (2) all the info about the lock can be
!    read in a single system call (readlink).  If the system doesn't
!    support symlinks, we use a normal file instead xx-unimpl.
!    
!    This is compatible with the locking scheme used by Interleaf (which
!    has contributed this implementation for Emacs), and was designed by
!    Ethan Jacobson, Kimbo Mundy, and others at Ileaf.
!    
!    --karl@cs.umb.edu/karl@hq.ileaf.com.  */
! 
! 
! /* Here is the structure that stores information about a lock.  */
! #define LOCK_USER_MAX 64
! #define LOCK_HOST_MAX 256
! 
! typedef struct
! {
!   char user[LOCK_USER_MAX];
!   char host[LOCK_HOST_MAX];
!   int pid;
! } lock_info_type;
! 
! /* When we read the info back, we might need this much more.  */
! #define LOCK_PID_MAX 21 /* enough for signed 64 bits plus null */
! #define LOCK_INFO_MAX (LOCK_USER_MAX + LOCK_HOST_MAX + LOCK_PID_MAX + 1)
  
+ /* Write the name of the lock file for FN into LFNAME.  Length will be
+    that of FN plus two more for the leading `.#' plus one for the null.  */
  #define MAKE_LOCK_PATH(lock, file) \
!   (lock = (char *) alloca (XSTRING (file)->size + 2 + 1), \
     fill_in_lock_file_name (lock, (file)))
  
! static void
  fill_in_lock_file_name (lockfile, fn)
       register char *lockfile;
*************** fill_in_lock_file_name (lockfile, fn)
*** 143,173 ****
    register char *p;
  
!   strcpy (lockfile, lock_path);
  
!   p = lockfile + strlen (lockfile);
  
!   strcpy (p, XSTRING (fn)->data);
  
!   for (; *p; p++)
      {
!       if (*p == '/')
! 	*p = '!';
      }
  }
- #endif /* !defined HAVE_LONG_FILE_NAMES */
  
! static Lisp_Object
! lock_file_owner_name (lfname)
       char *lfname;
  {
!   struct stat s;
!   struct passwd *the_pw;
  
!   if (lstat (lfname, &s) == 0)
!     the_pw = getpwuid (s.st_uid);
!   return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
  }
  
  
  /* lock_file locks file fn,
     meaning it serves notice on the world that you intend to edit that file.
--- 96,249 ----
    register char *p;
  
!   strcpy (lockfile, XSTRING (fn)->data);
  
!   /* Shift the nondirectory part of the filename (including the null)
!      right two characters.  xx14-char limit  */
!   for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
!     {
!       p[2] = *p;
!     }
  
!   /* Insert the `.#'.  */
!   p[1] = '.';
!   p[2] = '#';
! }
! 
! /* Lock the lock file named LFNAME.
!    If FORCE is nonzero, we do so even if it is already locked.
!    Return 1 if successful, 0 if not.  */
  
! static int
! lock_file_1 (lfname, force)
!      char *lfname; 
!      int force;
! {
!   register int err;
!   char *user_name = XSTRING (Fuser_login_name ())->data;
!   char *host_name = XSTRING (Fsystem_name ())->data;
!   char *lock_info_str = alloca (strlen (user_name) + strlen (host_name) + 21);
! 
!   sprintf (lock_info_str, "%s@%s.%d", user_name, host_name, getpid ());
! 
!   /* xxno symlinks? */
!   err = symlink (lock_info_str, lfname);
!   if (errno == EEXIST && force)
      {
!       unlink (lfname);
!       err = symlink (lock_info_str, lfname);
      }
+ 
+   return err == 0;
  }
  
! 
! /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
!    1 if another process owns it (and set OWNER (if non-null) to info),
!    2 if the current process owns it,
!    or -1 if something is wrong with the locking mechanism.  */
! 
! static int
! current_lock_owner (owner, lfname)
!      lock_info_type *owner;
       char *lfname;
  {
!   char lfinfo[LOCK_INFO_MAX];
!   char pid_str[LOCK_PID_MAX];
!   int o, p;
!   /* xxno symlinks? */
!   int len = readlink (lfname, lfinfo, LOCK_INFO_MAX);
!   
!   /* Nonexistent lock?  */
!   if (len == -1 && errno == ENOENT)
!     return 0;
!   
!   /* If link info filled up our buffer, must be someone else's link.  */
!   if (len == -1 || len == LOCK_INFO_MAX)
!     return -1;
  
!   /* Link info exists, so `len' is its length.  Null terminate.  */
!   lfinfo[len] = 0;
!   
!   /* Even if the caller doesn't want the owner info, we still have to
!      read it to determine return value, so allocate it.  */
!   if (!owner)
!     owner = alloca (sizeof (lock_info_type));
!   
!   /* Parse user@host.pid.  If can't parse, return -1.  */
!   for (o = 0; o < LOCK_USER_MAX && lfinfo[o] != 0 && lfinfo[o] != '@'; o++)
!     owner->user[o] = lfinfo[o];
!   if (lfinfo[o] != '@')
!     return -1;
!   owner->user[o] = 0;
!   
!   /* Go backwards to last period for the PID, in case the hostname
!      contains periods.  */
!   for (p = len; p > 0 && lfinfo[p] != '.'; p--)
!     ;
!   if (lfinfo[p] != '.')
!     return -1;
!   owner->pid = atoi (lfinfo + p + 1);
! 
!   /* The host is everything in `lfinfo' after `o' and before `p'.
!      Change the `.' to a null and we can just use `strcpy'.  */
!   lfinfo[p] = 0;
!   strcpy (owner->host, lfinfo + o + 1);
!   
!   /* On current host?  */
!   if (strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
!     {
!       if (owner->pid == getpid ())
!         return 2; /* We own it.  */
!       
!       if (owner->pid > 0
!                && (kill (owner->pid, 0) >= 0 || errno == EPERM))
!         return 1; /* Another process on this machine owns it.  */
!       
!       /* The owner process is dead or has a strange pid (<=0), so try to
!          zap the lockfile.  */
!       if (unlink (lfname) < 0)
!         return -1;
!       
!       return 0;
!     }
!   else
!     { /* xx remote process? */
!       return 1;
!     }
  }
  
  
+ /* Lock the lock named LFNAME if possible.
+    Return 0 in that case.
+    Return positive if some other process owns the lock, and info about
+      that process in CLASHER.
+    Return -1 if cannot lock for any other reason.  */
+ 
+ static int
+ lock_if_free (clasher, lfname)
+      lock_info_type *clasher;
+      register char *lfname; 
+ {
+   while (lock_file_1 (lfname, 0) == 0)
+     {
+       int locker;
+       
+       if (errno != EEXIST)
+ 	return -1;
+       
+       locker = current_lock_owner (clasher, lfname);
+       if (locker == 2)
+         return 0;   /* We ourselves locked it.  */
+       else if (locker == 1)
+         return 1;  /* Someone else has it.  */
+       else if (locker == -1)
+         return -1; /* Something's wrong.  */
+         
+        /* If some other error, or no such lock, try to lock again.  */
+        /* xx infinite loop on some errors? */
+     }
+   return 0;
+ }
+ 
  /* lock_file locks file fn,
     meaning it serves notice on the world that you intend to edit that file.
*************** lock_file_owner_name (lfname)
*** 183,199 ****
     If the file is locked by someone else, lock_buffer calls
     ask-user-about-lock (a Lisp function) with two arguments,
!    the file name and the name of the user who did the locking.
     This function can signal an error, or return t meaning
     take away the lock, or return nil meaning ignore the lock.  */
  
- /* The lock file name is the file name with "/" replaced by "!"
-    and put in the Emacs lock directory.  */
- /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
- 
- /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
-    representation of a 14-bytes CRC generated from the file name
-    and put in the Emacs lock directory (not very nice, but it works).
-    (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
- 
  void
  lock_file (fn)
--- 259,266 ----
     If the file is locked by someone else, lock_buffer calls
     ask-user-about-lock (a Lisp function) with two arguments,
!    the file name and info about the user who did the locking.
     This function can signal an error, or return t meaning
     take away the lock, or return nil meaning ignore the lock.  */
  
  void
  lock_file (fn)
*************** lock_file (fn)
*** 201,207 ****
  {
    register Lisp_Object attack;
!   register char *lfname;
! 
!   MAKE_LOCK_PATH (lfname, fn);
  
    /* See if this file is visited and has changed on disk since it was
--- 268,273 ----
  {
    register Lisp_Object attack;
!   register char *lfname, *locker;
!   lock_info_type lock_info;
  
    /* See if this file is visited and has changed on disk since it was
*************** lock_file (fn)
*** 216,326 ****
    }
  
    /* Try to lock the lock. */
!   if (lock_if_free (lfname) <= 0)
!     /* Return now if we have locked it, or if lock dir does not exist */
      return;
  
    /* Else consider breaking the lock */
!   attack = call2 (intern ("ask-user-about-lock"), fn,
! 		  lock_file_owner_name (lfname));
    if (!NILP (attack))
      /* User says take the lock */
      {
!       lock_superlock (lfname);
!       lock_file_1 (lfname, O_WRONLY) ;
!       unlink (superlock_path);
        return;
      }
    /* User says ignore the lock */
  }
- 
- /* Lock the lock file named LFNAME.
-    If MODE is O_WRONLY, we do so even if it is already locked.
-    If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
-    Return 1 if successful, 0 if not.  */
- 
- int
- lock_file_1 (lfname, mode)
-      int mode; char *lfname; 
- {
-   register int fd;
-   char buf[20];
- 
-   if ((fd = open (lfname, mode, 0666)) >= 0)
-     {
- #ifdef USG
-       chmod (lfname, 0666);
- #else
-       fchmod (fd, 0666);
- #endif
-       sprintf (buf, "%d ", getpid ());
-       write (fd, buf, strlen (buf));
-       close (fd);
-       return 1;
-     }
-   else
-     return 0;
- }
- 
- /* Lock the lock named LFNAME if possible.
-    Return 0 in that case.
-    Return positive if lock is really locked by someone else.
-    Return -1 if cannot lock for any other reason.  */
- 
- int
- lock_if_free (lfname)
-      register char *lfname; 
- {
-   register int clasher;
- 
-   while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
-     {
-       if (errno != EEXIST)
- 	return -1;
-       clasher = current_lock_owner (lfname);
-       if (clasher != 0)
- 	if (clasher != getpid ())
- 	  return (clasher);
- 	else return (0);
-       /* Try again to lock it */
-     }
-   return 0;
- }
- 
- /* Return the pid of the process that claims to own the lock file LFNAME,
-    or 0 if nobody does or the lock is obsolete,
-    or -1 if something is wrong with the locking mechanism.  */
- 
- int
- current_lock_owner (lfname)
-      char *lfname;
- {
-   int owner = current_lock_owner_1 (lfname);
-   if (owner == 0 && errno == ENOENT)
-     return (0);
-   /* Is it locked by a process that exists?  */
-   if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
-     return (owner);
-   if (unlink (lfname) < 0)
-     return (-1);
-   return (0);
- }
- 
- int
- current_lock_owner_1 (lfname)
-      char *lfname;
- {
-   register int fd;
-   char buf[20];
-   int tem;
- 
-   fd = open (lfname, O_RDONLY, 0666);
-   if (fd < 0)
-     return 0;
-   tem = read (fd, buf, sizeof buf);
-   close (fd);
-   return (tem <= 0 ? 0 : atoi (buf));
- }
- 
  
  void
--- 282,308 ----
    }
  
+   /* Create the name of the lock-file for file fn */
+   MAKE_LOCK_PATH (lfname, fn);
+ 
    /* Try to lock the lock. */
!   if (lock_if_free (&lock_info, lfname) <= 0)
!     /* Return now if we have locked it, or if lock creation failed */
      return;
  
    /* Else consider breaking the lock */
!   locker = alloca (strlen (lock_info.user) + strlen (lock_info.host)
!                    + LOCK_PID_MAX + 9);
!   sprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
!            lock_info.pid);
!   
!   attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
    if (!NILP (attack))
      /* User says take the lock */
      {
!       lock_file_1 (lfname, 1);
        return;
      }
    /* User says ignore the lock */
  }
  
  void
*************** unlock_file (fn)
*** 332,374 ****
    MAKE_LOCK_PATH (lfname, fn);
  
!   lock_superlock (lfname);
! 
!   if (current_lock_owner_1 (lfname) == getpid ())
      unlink (lfname);
- 
-   unlink (superlock_path);
- }
- 
- lock_superlock (lfname)
-      char *lfname;
- {
-   register int i, fd;
-   DIR *lockdir;
- 
-   for (i = -20; i < 0 && (fd = open (superlock_path,
- 				     O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
-        i++)
-     {
-       if (errno != EEXIST)
- 	return;
- 
-       /* This seems to be necessary to prevent Emacs from hanging when the
- 	 competing process has already deleted the superlock, but it's still
- 	 in the NFS cache.  So we force NFS to synchronize the cache.  */
-       if (lockdir = opendir (lock_path))
- 	closedir (lockdir);
- 
-       sleep (1);
-     }
-   if (fd >= 0)
-     {
- #ifdef USG
-       chmod (superlock_path, 0666);
- #else
-       fchmod (fd, 0666);
- #endif
-       write (fd, lfname, strlen (lfname));
-       close (fd);
-     }
  }
  
--- 314,319 ----
    MAKE_LOCK_PATH (lfname, fn);
  
!   if (current_lock_owner (0, lfname) == 2)
      unlink (lfname);
  }
  
*************** unlock_all_files ()
*** 388,392 ****
      }
  }
- 
  
  DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
--- 333,336 ----
*************** if it should normally be locked.")
*** 419,423 ****
    return Qnil;
  }
- 
  
  /* Unlock the file visited in buffer BUFFER.  */
--- 363,366 ----
*************** unlock_buffer (buffer)
*** 426,431 ****
       struct buffer *buffer;
  {
!   if (buffer->save_modified < BUF_MODIFF (buffer) &&
!       XTYPE (buffer->filename) == Lisp_String)
      unlock_file (buffer->filename);
  }
--- 369,374 ----
       struct buffer *buffer;
  {
!   if (buffer->save_modified < BUF_MODIFF (buffer)
!       && XTYPE (buffer->filename) == Lisp_String)
      unlock_file (buffer->filename);
  }
*************** t if it is locked by you, else a string 
*** 439,442 ****
--- 382,386 ----
    register char *lfname;
    int owner;
+   lock_info_type locker;
  
    fn = Fexpand_file_name (fn, Qnil);
*************** t if it is locked by you, else a string 
*** 444,456 ****
    MAKE_LOCK_PATH (lfname, fn);
  
!   owner = current_lock_owner (lfname);
    if (owner <= 0)
      return (Qnil);
!   else if (owner == getpid ())
      return (Qt);
!   
!   return (lock_file_owner_name (lfname));
  }
- 
  
  /* Initialization functions.  */
--- 388,399 ----
    MAKE_LOCK_PATH (lfname, fn);
  
!   owner = current_lock_owner (&locker, lfname);
    if (owner <= 0)
      return (Qnil);
!   else if (owner == 2)
      return (Qt);
!   else
!     return build_string (locker.user);
  }
  
  /* Initialization functions.  */
*************** t if it is locked by you, else a string 
*** 458,478 ****
  init_filelock ()
  {
-   lock_path = egetenv ("EMACSLOCKDIR");
-   if (! lock_path)
-     lock_path = PATH_LOCK;
- 
-   /* Make sure it ends with a slash.  */
-   if (lock_path[strlen (lock_path) - 1] != '/')
-     {
-       char *new_path = (char *) xmalloc (strlen (lock_path) + 2);
-       strcpy (new_path, lock_path);
-       lock_path = new_path;
-       strcat (lock_path, "/");
-     }
- 
-   superlock_path = (char *) xmalloc ((strlen (lock_path)
- 				      + sizeof (SUPERLOCK_NAME)));
-   strcpy (superlock_path, lock_path);
-   strcat (superlock_path, SUPERLOCK_NAME);
  }
  
--- 401,404 ----
*** ./ORIG/syssignal.h	Wed Jul 27 14:08:56 1994
--- ./syssignal.h	Sun Sep 25 09:42:45 1994
*************** extern sigset_t sys_sigmask ();
*** 55,59 ****
--- 55,61 ----
  #define sighold(SIG)     ONLY_USED_IN_BSD_4_1
  #define sigrelse(SIG)    ONLY_USED_IN_BSD_4_1
+ #ifndef signal /* defined in some config files */
  #define signal(SIG,ACT)      sys_signal(SIG,ACT)
+ #endif
  
  /* Whether this is what all systems want or not, this is what
*** ./ORIG/editfns.c	Tue Aug 30 03:18:50 1994
--- ./editfns.c	Sun Sep 11 11:43:07 1994
*************** init_editfns ()
*** 58,61 ****
--- 58,68 ----
    init_system_name ();
  
+   /* We edit lisp/version.el, hence we make a lock for it, hence we need
+      the user name.  But when do all the stuff below to figure out the
+      user name before dumping, yellow pages gets confused (Sparc 10,
+      SunOS 4.1.3), and the dumped emacs gets a segmentation fault in an
+      internal yp routine.  So, just use a constant string in temacs.  */
+   Vuser_name = build_string ("temacs");
+ 
  #ifndef CANNOT_DUMP
    /* Don't bother with this on initial start when just dumping out */