🚀 go-pugleaf

In article <8905070035.AA13356@transit.cs.brown.edu> cs126045@CS.BROWN.EDU writes:
   Problem: In the file locking code for GNU Emacs version 18.54.....

There are a number of problems with GNU emacs file locking.  The following
code is a complete replacement for src/filelock.c that fixes some of them
(and introduces some others, see the header).  The only thing necessary to
get it running should be to put the following in paths.h (replacing the
existing lockfile defines), and replace filelock.c with what follows.
We've been running it for a couple of weeks now without any problems on our
Sun network.  The code is quite straignt forward so if it doesn't plug and
play it should be easy to fix.

Comments/improvements welcome.

-----------------------Add to paths.h

/* Lock files are created in the directory where the file being locked
   will go.
 */

/* A string which will be prepended onto the name of the file being
   locked.  For example; if file /mumble/bar.type is to be locked, the
   resulting lock file will be /mumble/LOCKFILEPREFIXbar.type
 */
#define LOCKFILEPREFIX ".!E!m!A!c!S!l!O!c!K!."

/* The name of the file that will be used as the superlock.  It will be
   created in the directory that contains the file to be locked.
 */
#define SUPERLOCK_FILE_NAME ".!E!m!A!c!S!s!U!p!E!r!L!o!C!k!."


-----------------------filelock.c

/* Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY.  No author or distributor
accepts responsibility to anyone for the consequences of using it
or for whether it serves any particular purpose or works at all,
unless he says so in writing.  Refer to the GNU Emacs General Public
License for full details.

Everyone is granted permission to copy, modify and redistribute
GNU Emacs, but only under the conditions described in the
GNU Emacs General Public License.   A copy of this license is
supposed to have been given to you along with GNU Emacs so you
can know your rights and responsibilities.  It should be in a
file named COPYING.  Among other things, the copyright notice
and this notice must be preserved on all copies.  */

/* The following provides a file locking mechanism for GNU emacs in which
   lock files are created in the directory where the file being locked
   exists (see LOCKFILEPREFIX & SUPERLOCK_FILE_NAME in paths.h).  The
   previous file locking mechanism was to create lock files in a single
   directory that everybody had write access to, where the lock file name
   was the name name of the file being locked with "/" replaced by "!".
   The file contained the pid of the locking process, so that broken locks
   could be identified.

   The old file locking scheme could lose several ways:

     1. In a network environment, a single point of contact for lock files
        results in bottlenecks, and single point failures.
     2. In a network environment, pid numbers are not adequate to identify
        processes; machine names must be taken into account, as well.
	In point of fact, adding just the machine name is not enough in
	subnetted networks, but the probability that machines with the same
	name, having the same pid running emacs, for the same user id, both
	trying to modify the same file, is fairly low.
     3. If a file was accessible via different paths, (e.g., the path name
        contained symbolic links, or was accessible via a different mount
	point) the lock file name wouldn't be the same, and access violations
	would arise.
     4. Hard links give files different names, so lock file names don't
        match.

   The scheme implemented by the following code is to write lock files in the
   same directory as the file being locked (we still use a superlock file, and
   it too is in the same directory as the file being locked).  The lock file
   contains the user name, pid, the date the lock was acquired, and the
   machine name on which the locking process is executing.  Because the lock
   files are in the same dir as the file being locked, it gets around problems
   1 & 2 above, and minimizes the impact of 3.  You can however loose in
   different ways:

     A. If the file visited is a symbolic link, you still loose.  This is
        also a problem for backup files, so presumably users are somewhat
	aware of it.
     B. Still doesn't handle hard links.  We considered using the inode
        of the file, but you can loose in a large number of ways, and it
	complicates the locking strategy considerably.
     C. If you don't have write access to the directory where the file
        you are writing will go, you will be unable to lock the file.
	Once again, autosaves and backup files already have this problem,
	so presumably users are aware of it.
     D. If the name of the lock file coincides with the name of an existing
        file, AND if ask-user-about-lock returns T even though the user
	name is NIL, AND the user has write access to the file, then it is
	possible that data could be overwritten.  A judicious choice of
	LOCKFILEPREFIX should reduce this possiblity to near zero.

   The following code implements the same interface as the previous
   file, and does not do any more file I/O than the old method.
 */


/* Written by Aaron Larson & Jeff Clark, Apr 22, 1989, based on the
   version suplied with GNU Emacs, 18.52.
 */

#include <sys/types.h>
#include "config.h"
#include "lisp.h"
#include "paths.h"
#include "buffer.h"
#include <pwd.h>
#include <errno.h>
#include <sys/file.h>
#ifdef USG
#include <fcntl.h>
#endif /* USG */

extern int errno;

#ifdef CLASH_DETECTION

#define ATTEMPT_LOCK (O_WRONLY | O_EXCL | O_CREAT)
#define STEAL_LOCK O_WRONLY

#define MAX_LOCKFILE_LINE 200

#define BUILD_LOCK_FILE_NAME(fn, fn_dir, lfname) \
  lfname = (char *) alloca (XSTRING (fn)->size + strlen(LOCKFILEPREFIX) + 1); \
  sprintf(lfname, "%s%s%s",						      \
	  XSTRING(fn_dir)->data,					      \
	  LOCKFILEPREFIX,						      \
	  XSTRING(Ffile_name_nondirectory(fn))->data)

#define BUILD_SUPERLOCK_FILE_NAME(fn_dir, slfname) \
  slfname = (char *) alloca (XSTRING (fn_dir)->size + strlen(SUPERLOCK_FILE_NAME) + 1); \
  sprintf(slfname, "%s%s",						      \
	  XSTRING(fn_dir)->data,					      \
	  SUPERLOCK_FILE_NAME)

void lock_superlock(); 
void unlock_superlock(); 

/* lock_file locks file fn,

   meaning it serves notice on the world that you intend to edit that file.
   This should be done only when about to modify a file-visiting buffer
   previously unmodified.  Do not (normally) call lock_buffer for a buffer
   already modified, as either the file is already locked, or the user has
   already decided to go ahead without locking.

   When lock_buffer returns, either the lock is locked for us, or the user has
   said to go ahead without locking.

   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 is created in the same dir as the file being locked.  The lock
   file name is (the value of the #define) LOCKFILEPREFIX concatenated with
   the name of the file being locked.
*/

void
lock_file (fn)
     register Lisp_Object fn;
{
  register Lisp_Object attack;
  register char *lfname;
  Lisp_Object fn_dir;

  /* See if this file is visited and has changed on disk since it was visited.  */
  {
    register Lisp_Object subject_buf = Fget_file_buffer (fn);
    if (!NULL (subject_buf)
	&& NULL (Fverify_visited_file_modtime (subject_buf))
	&& !NULL (Ffile_exists_p (fn)))
      call1 (intern ("ask-user-about-supersession-threat"), fn);
  }

  /* Create the path name of the lock-file for file fn */
  fn_dir = Ffile_name_directory(fn);
  BUILD_LOCK_FILE_NAME(fn, fn_dir, lfname);

  /* Try to lock the lock. */
  if ( (lock_file_1 (lfname, ATTEMPT_LOCK, XSTRING(fn)->data) == 0) || (errno != EEXIST))
    /* Return now if we have locked it, or if lock dir not writable */
    return;

  /* Else consider breaking the lock */
  attack = call2 (intern ("ask-user-about-lock"), fn,
		  lock_file_owner_name (lfname));
  if (!NULL (attack))
    /* User says take the lock */
    {
      lock_superlock (fn_dir, lfname);
      lock_file_1 (lfname, STEAL_LOCK, XSTRING(fn)->data) ;
      unlock_superlock (fn_dir);
      return;
    }
  /* User says honor the lock */
}


/* Lock the lock file named LFNAME.
   If parameter MODE is ATTEMPT_LOCK, we do so only if it is free.
   If parameter MODE is STEAL_LOCK, we do so even if it is already locked.
   Return 0 if successful, -1 if not.
*/
int
lock_file_1 (lfname, mode, fname)
     int mode; char *lfname, *fname; 
{
  register int fd;
  char buf[MAX_LOCKFILE_LINE];
  char hostname[32];

  if ((fd = open (lfname, mode, 0666)) >= 0)
    {
      long now = time ( (long *) 0);
      register char *timestr = (char *) ctime (&now);
      extern struct passwd *getpwuid ();

      timestr [24] = 0;

      fchmod (fd, 0666);
      gethostname(hostname, 32);
      sprintf (buf, "%s on %s (PID %d) since %s\n",
	       getpwuid (getuid())->pw_name,
	       hostname,
	       getpid(),
	       timestr);
      write (fd, buf, strlen (buf));
      write (fd, fname, strlen(fname));
      close (fd);
      return 0;
    }
  else
    if (EQ(this_process_locking_file(lfname), Qt))
      return 0;
    else
      return -1;
}

static Lisp_Object
lock_file_owner_name (lfname)
{
  register int fd;
  char buf[MAX_LOCKFILE_LINE];
  int tem, i;

  fd = open (lfname, O_RDONLY, 0666);
  if (fd < 0)
    return Qnil;
  tem = read (fd, buf, sizeof buf);
  close (fd);
  if (tem < 0)
    return(Qnil);
  for ( i = 0; (i < tem) && (buf[i] != '\n') ; i++);
  buf[i]=0;
  return(build_string(buf));
}



void
lock_superlock (fn_dir, lfname)
     Lisp_Object fn_dir;
     char *lfname;
{
  register int i, fd;
  char *slfname;

  BUILD_SUPERLOCK_FILE_NAME(fn_dir, slfname);
  for (i = -20; i < 0 && (fd = open (slfname,
				     O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
       i++)
    {
      if (errno != EEXIST)
	return;
      sleep (1);
    }
  if (fd >= 0)
    {
      fchmod (fd, 0666);
      write (fd, lfname, strlen (lfname));
      close (fd);
    }
}


void
unlock_superlock(fn_dir)
     Lisp_Object fn_dir;
{
  register char *slfname;

  BUILD_SUPERLOCK_FILE_NAME(fn_dir, slfname);
  unlink(slfname);
}

void
unlock_file (fn)
     register Lisp_Object fn;
{
  register char *lfname;
  Lisp_Object fn_dir;

  fn_dir = Ffile_name_directory(fn);
  BUILD_LOCK_FILE_NAME(fn, fn_dir, lfname);
  lock_superlock (fn_dir, lfname);

  if (EQ(this_process_locking_file (lfname), Qt))
    unlink (lfname);

  unlock_superlock(fn_dir);
}

/* Return Qt if it can be determined that the current process owns the lock
   file LFNAME, return Qnil if we are massively confused, and Return a string
   describing the lock owner otherwise.  This string will be the info written
   into the lock file by the function `lock_file_1', above.
*/
Lisp_Object
this_process_locking_file (lfname)
     char *lfname;
{
  Lisp_Object owner = lock_file_owner_name(lfname);
  char hostname[32], machine[32];
  int pid;

  if ( NULL(owner) )
    return(Qnil);

  if (sscanf(XSTRING(owner)->data, "%*s on %s (PID %d)", machine, &pid) < 2)
    return(Qnil);

  gethostname(hostname, 32);
  if ( (strcmp(machine, hostname) == 0) && (pid == getpid()))
    return(Qt);
  else
    return(owner);
}

void
unlock_all_files ()
{
  register Lisp_Object tail;
  register struct buffer *b;

  for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
       tail = XCONS (tail)->cdr)
    {
      b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
      if (XTYPE (b->filename) == Lisp_String &&
	  b->save_modified < b->text.modified)
	unlock_file (b->filename);
    }
}


DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
  0, 1, 0,
  "Locks FILE, if current buffer is modified.\n\
FILE defaults to current buffer's visited file,\n\
or else nothing is done if current buffer isn't visiting a file.")
  (fn)
     Lisp_Object fn;
{
  if (NULL (fn))
    fn = bf_cur->filename;
  else
    CHECK_STRING (fn, 0);
  if (bf_cur->save_modified < bf_modified
      && !NULL (fn))
    lock_file (fn);
  return Qnil;    
}

DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
  0, 0, 0,
 "Unlocks the file visited in the current buffer,\n\
if it should normally be locked.")
  ()
{
  if (bf_cur->save_modified < bf_modified &&
      XTYPE (bf_cur->filename) == Lisp_String)
    unlock_file (bf_cur->filename);
  return Qnil;
}


/* Unlock the file visited in buffer BUFFER.  */

unlock_buffer (buffer)
     struct buffer *buffer;
{
  bf_cur->text.modified = bf_modified;
  if (buffer->save_modified < buffer->text.modified &&
      XTYPE (buffer->filename) == Lisp_String)
    unlock_file (buffer->filename);
}

DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
  "Returns nil if the FILENAME is not locked,\n\
t if it is locked by you, else a string of the name of the locker.")
  (fn)
  Lisp_Object fn;
{
  register char *lfname;
  Lisp_Object fn_dir;

  fn = Fexpand_file_name (fn, Qnil);
  fn_dir = Ffile_name_directory(fn);

  /* Create the path name of the lock-file for file fn */
  BUILD_LOCK_FILE_NAME(fn, fn_dir, lfname);
  return(this_process_locking_file (lfname));

}

syms_of_filelock ()
{
  defsubr (&Sunlock_buffer);
  defsubr (&Slock_buffer);
  defsubr (&Sfile_locked_p);
}

#endif /* CLASH_DETECTION */