src/filelock.c

   1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
   2
   3 This file is part of GNU Emacs.
   4
   5 GNU Emacs is free software; you can redistribute it and/or modify
   6 it under the terms of the GNU General Public License as published by
   7 the Free Software Foundation; either version 2, or (at your option)
   8 any later version.
   9
  10 GNU Emacs is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 GNU General Public License for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with GNU Emacs; see the file COPYING.  If not, write to
  17 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  18 Boston, MA 02111-1307, USA.  */
  19
  20
  21 #include <sys/types.h>
  22 #include <sys/stat.h>
  23 #include <config.h>
  24
  25 #ifdef VMS
  26 #include "vms-pwd.h"
  27 #else
  28 #include <pwd.h>
  29 #endif /* not VMS */
  30
  31 #include <sys/file.h>
  32 #ifdef USG
  33 #include <fcntl.h>
  34 #include <string.h>
  35 #endif /* USG */
  36
  37 #include "lisp.h"
  38 #include "buffer.h"
  39
  40 #include <errno.h>
  41 #ifndef errno
  42 extern int errno;
  43 #endif
  44
  45 #ifdef CLASH_DETECTION
  46
  47 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
  48    directory, with link data `user@host.pid'.  This avoids a single
  49    mount (== failure) point for lock files.
  50
  51    When the host in the lock data is the current host, we can check if
  52    the pid is valid with kill.
  53
  54    Otherwise, we could look at a separate file that maps hostnames to
  55    reboot times to see if the remote pid can possibly be valid, since we
  56    don't want Emacs to have to communicate via pipes or sockets or
  57    whatever to other processes, either locally or remotely; rms says
  58    that's too unreliable.  Hence the separate file, which could
  59    theoretically be updated by daemons running separately -- but this
  60    whole idea is unimplemented; in practice, at least in our
  61    environment, it seems such stale locks arise fairly infrequently, and
  62    Emacs' standard methods of dealing with clashes suffice.
  63
  64    We use symlinks instead of normal files because (1) they can be
  65    stored more efficiently on the filesystem, since the kernel knows
  66    they will be small, and (2) all the info about the lock can be read
  67    in a single system call (readlink).  Although we could use regular
  68    files to be useful on old systems lacking symlinks, nowadays
  69    virtually all such systems are probably single-user anyway, so it
  70    didn't seem worth the complication.
  71
  72    Similarly, we don't worry about a possible 14-character limit on
  73    file names, because those are all the same systems that don't have
  74    symlinks.
  75
  76    This is compatible with the locking scheme used by Interleaf (which
  77    has contributed this implementation for Emacs), and was designed by
  78    Ethan Jacobson, Kimbo Mundy, and others.
  79
  80    --karl@cs.umb.edu/karl@hq.ileaf.com.  */
  81
  82 \f
  83 /* Here is the structure that stores information about a lock.  */
  84
  85 typedef struct
  86 {
  87   char *user;
  88   char *host;
  89   unsigned long pid;
  90 } lock_info_type;
  91
  92 /* When we read the info back, we might need this much more,
  93    enough for decimal representation plus null.  */
  94 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
  95
  96 /* Free the two dynamically-allocated pieces in PTR.  */
  97 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
  98
  99
 100 /* Write the name of the lock file for FN into LFNAME.  Length will be
 101    that of FN plus two more for the leading `.#' plus one for the null.  */
 102 #define MAKE_LOCK_NAME(lock, file) \
 103   (lock = (char *) alloca (XSTRING (file)->size + 2 + 1), \
 104    fill_in_lock_file_name (lock, (file)))
 105
 106 static void
 107 fill_in_lock_file_name (lockfile, fn)
 108      register char *lockfile;
 109      register Lisp_Object fn;
 110 {
 111   register char *p;
 112
 113   strcpy (lockfile, XSTRING (fn)->data);
 114
 115   /* Shift the nondirectory part of the file name (including the null)
 116      right two characters.  Here is one of the places where we'd have to
 117      do something to support 14-character-max file names.  */
 118   for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
 119     p[2] = *p;
 120
 121   /* Insert the `.#'.  */
 122   p[1] = '.';
 123   p[2] = '#';
 124 }
 125
 126 /* Lock the lock file named LFNAME.
 127    If FORCE is nonzero, we do so even if it is already locked.
 128    Return 1 if successful, 0 if not.  */
 129
 130 static int
 131 lock_file_1 (lfname, force)
 132      char *lfname;
 133      int force;
 134 {
 135   register int err;
 136   char *user_name;
 137   char *host_name;
 138   char *lock_info_str;
 139
 140   if (STRINGP (Fuser_login_name (Qnil)))
 141     user_name = XSTRING (Fuser_login_name (Qnil))->data;
 142   else
 143     user_name = "";
 144   if (STRINGP (Fsystem_name ()))
 145     host_name = XSTRING (Fsystem_name ())->data;
 146   else
 147     host_name = "";
 148   lock_info_str = alloca (strlen (user_name) + strlen (host_name)
 149                           + LOCK_PID_MAX + 5);
 150
 151   sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
 152            (unsigned long) getpid ());
 153
 154   err = symlink (lock_info_str, lfname);
 155   if (errno == EEXIST && force)
 156     {
 157       unlink (lfname);
 158       err = symlink (lock_info_str, lfname);
 159     }
 160
 161   return err == 0;
 162 }
 163
 164
 165 \f
 166 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
 167    1 if another process owns it (and set OWNER (if non-null) to info),
 168    2 if the current process owns it,
 169    or -1 if something is wrong with the locking mechanism.  */
 170
 171 static int
 172 current_lock_owner (owner, lfname)
 173      lock_info_type *owner;
 174      char *lfname;
 175 {
 176 #ifndef index
 177   extern char *rindex (), *index ();
 178 #endif
 179   int o, p, len, ret;
 180   int local_owner = 0;
 181   char *at, *dot;
 182   char *lfinfo = 0;
 183   int bufsize = 50;
 184   /* Read arbitrarily-long contents of symlink.  Similar code in
 185      file-symlink-p in fileio.c.  */
 186   do
 187     {
 188       bufsize *= 2;
 189       lfinfo = (char *) xrealloc (lfinfo, bufsize);
 190       len = readlink (lfname, lfinfo, bufsize);
 191     }
 192   while (len >= bufsize);
 193
 194   /* If nonexistent lock file, all is well; otherwise, got strange error. */
 195   if (len == -1)
 196     {
 197       xfree (lfinfo);
 198       return errno == ENOENT ? 0 : -1;
 199     }
 200
 201   /* Link info exists, so `len' is its length.  Null terminate.  */
 202   lfinfo[len] = 0;
 203
 204   /* Even if the caller doesn't want the owner info, we still have to
 205      read it to determine return value, so allocate it.  */
 206   if (!owner)
 207     {
 208       owner = (lock_info_type *) alloca (sizeof (lock_info_type));
 209       local_owner = 1;
 210     }
 211
 212   /* Parse USER@HOST.PID.  If can't parse, return -1.  */
 213   /* The USER is everything before the first @.  */
 214   at = index (lfinfo, '@');
 215   dot = rindex (lfinfo, '.');
 216   if (!at || !dot) {
 217     xfree (lfinfo);
 218     return -1;
 219   }
 220   len = at - lfinfo;
 221   owner->user = (char *) xmalloc (len + 1);
 222   strncpy (owner->user, lfinfo, len);
 223   owner->user[len] = 0;
 224
 225   /* The PID is everything after the last `.'.  */
 226   owner->pid = atoi (dot + 1);
 227
 228   /* The host is everything in between.  */
 229   len = dot - at - 1;
 230   owner->host = (char *) xmalloc (len + 1);
 231   strncpy (owner->host, at + 1, len);
 232   owner->host[len] = 0;
 233
 234   /* We're done looking at the link info.  */
 235   xfree (lfinfo);
 236
 237   /* On current host?  */
 238   if (STRINGP (Fsystem_name ())
 239       && strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
 240     {
 241       if (owner->pid == getpid ())
 242         ret = 2; /* We own it.  */
 243
 244       if (owner->pid > 0
 245                && (kill (owner->pid, 0) >= 0 || errno == EPERM))
 246         ret = 1; /* An existing process on this machine owns it.  */
 247
 248       /* The owner process is dead or has a strange pid (<=0), so try to
 249          zap the lockfile.  */
 250       if (unlink (lfname) < 0)
 251         ret = -1;
 252
 253       ret = 0;
 254     }
 255   else
 256     { /* If we wanted to support the check for stale locks on remote machines,
 257          here's where we'd do it.  */
 258       ret = 1;
 259     }
 260
 261   /* Avoid garbage.  */
 262   if (local_owner || ret <= 0)
 263     {
 264       FREE_LOCK_INFO (*owner);
 265     }
 266   return ret;
 267 }
 268
 269 \f
 270 /* Lock the lock named LFNAME if possible.
 271    Return 0 in that case.
 272    Return positive if some other process owns the lock, and info about
 273      that process in CLASHER.
 274    Return -1 if cannot lock for any other reason.  */
 275
 276 static int
 277 lock_if_free (clasher, lfname)
 278      lock_info_type *clasher;
 279      register char *lfname;
 280 {
 281   while (lock_file_1 (lfname, 0) == 0)
 282     {
 283       int locker;
 284
 285       if (errno != EEXIST)
 286         return -1;
 287
 288       locker = current_lock_owner (clasher, lfname);
 289       if (locker == 2)
 290         {
 291           FREE_LOCK_INFO (*clasher);
 292           return 0;   /* We ourselves locked it.  */
 293         }
 294       else if (locker == 1)
 295         return 1;  /* Someone else has it.  */
 296       else if (locker == -1)
 297         return -1; /* Something's wrong.  */
 298
 299        /* If some other error, or no such lock, try to lock again.  */
 300        /* Is there a case where we loop forever?  */
 301     }
 302   return 0;
 303 }
 304
 305 /* lock_file locks file FN,
 306    meaning it serves notice on the world that you intend to edit that file.
 307    This should be done only when about to modify a file-visiting
 308    buffer previously unmodified.
 309    Do not (normally) call this for a buffer already modified,
 310    as either the file is already locked, or the user has already
 311    decided to go ahead without locking.
 312
 313    When this returns, either the lock is locked for us,
 314    or the user has said to go ahead without locking.
 315
 316    If the file is locked by someone else, this calls
 317    ask-user-about-lock (a Lisp function) with two arguments,
 318    the file name and info about the user who did the locking.
 319    This function can signal an error, or return t meaning
 320    take away the lock, or return nil meaning ignore the lock.  */
 321
 322 void
 323 lock_file (fn)
 324     register Lisp_Object fn;
 325 {
 326   register Lisp_Object attack, orig_fn;
 327   register char *lfname, *locker;
 328   lock_info_type lock_info;
 329
 330   orig_fn = fn;
 331   fn = Fexpand_file_name (fn, Qnil);
 332
 333   /* Create the name of the lock-file for file fn */
 334   MAKE_LOCK_NAME (lfname, fn);
 335
 336   /* See if this file is visited and has changed on disk since it was
 337      visited.  */
 338   {
 339     register Lisp_Object subject_buf;
 340     subject_buf = get_truename_buffer (orig_fn);
 341     if (!NILP (subject_buf)
 342         && NILP (Fverify_visited_file_modtime (subject_buf))
 343         && !NILP (Ffile_exists_p (fn)))
 344       call1 (intern ("ask-user-about-supersession-threat"), fn);
 345   }
 346
 347   /* Try to lock the lock. */
 348   if (lock_if_free (&lock_info, lfname) <= 0)
 349     /* Return now if we have locked it, or if lock creation failed */
 350     return;
 351
 352   /* Else consider breaking the lock */
 353   locker = alloca (strlen (lock_info.user) + strlen (lock_info.host)
 354                    + LOCK_PID_MAX + 9);
 355   sprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
 356            lock_info.pid);
 357   FREE_LOCK_INFO (lock_info);
 358
 359   attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
 360   if (!NILP (attack))
 361     /* User says take the lock */
 362     {
 363       lock_file_1 (lfname, 1);
 364       return;
 365     }
 366   /* User says ignore the lock */
 367 }
 368
 369 void
 370 unlock_file (fn)
 371      register Lisp_Object fn;
 372 {
 373   register char *lfname;
 374
 375   fn = Fexpand_file_name (fn, Qnil);
 376
 377   MAKE_LOCK_NAME (lfname, fn);
 378
 379   if (current_lock_owner (0, lfname) == 2)
 380     unlink (lfname);
 381 }
 382
 383 void
 384 unlock_all_files ()
 385 {
 386   register Lisp_Object tail;
 387   register struct buffer *b;
 388
 389   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
 390     {
 391       b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
 392       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 393         unlock_file (b->file_truename);
 394     }
 395 }
 396 \f
 397 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 398   0, 1, 0,
 399   "Lock FILE, if current buffer is modified.\n\
 400 FILE defaults to current buffer's visited file,\n\
 401 or else nothing is done if current buffer isn't visiting a file.")
 402   (file)
 403      Lisp_Object file;
 404 {
 405   if (NILP (file))
 406     file = current_buffer->file_truename;
 407   else
 408     CHECK_STRING (file, 0);
 409   if (SAVE_MODIFF < MODIFF
 410       && !NILP (file))
 411     lock_file (file);
 412   return Qnil;
 413 }
 414
 415 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 416   0, 0, 0,
 417  "Unlock the file visited in the current buffer,\n\
 418 if it should normally be locked.")
 419   ()
 420 {
 421   if (SAVE_MODIFF < MODIFF
 422       && STRINGP (current_buffer->file_truename))
 423     unlock_file (current_buffer->file_truename);
 424   return Qnil;
 425 }
 426
 427 /* Unlock the file visited in buffer BUFFER.  */
 428
 429 unlock_buffer (buffer)
 430      struct buffer *buffer;
 431 {
 432   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 433       && STRINGP (buffer->file_truename))
 434     unlock_file (buffer->file_truename);
 435 }
 436
 437 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
 438   "Return nil if the FILENAME is not locked,\n\
 439 t if it is locked by you, else a string of the name of the locker.")
 440   (filename)
 441   Lisp_Object filename;
 442 {
 443   Lisp_Object ret;
 444   register char *lfname;
 445   int owner;
 446   lock_info_type locker;
 447
 448   filename = Fexpand_file_name (filename, Qnil);
 449
 450   MAKE_LOCK_NAME (lfname, filename);
 451
 452   owner = current_lock_owner (&locker, lfname);
 453   if (owner <= 0)
 454     ret = Qnil;
 455   else if (owner == 2)
 456     ret = Qt;
 457   else
 458     ret = build_string (locker.user);
 459
 460   if (owner > 0)
 461     FREE_LOCK_INFO (locker);
 462
 463   return ret;
 464 }
 465
 466 \f
 467 /* Initialization functions.  */
 468
 469 init_filelock ()
 470 {
 471 #if 0
 472   char *new_name;
 473
 474   lock_dir = egetenv ("EMACSLOCKDIR");
 475   if (! lock_dir)
 476     lock_dir = PATH_LOCK;
 477
 478   /* Copy the name in case egetenv got it from a Lisp string.  */
 479   new_name = (char *) xmalloc (strlen (lock_dir) + 2);
 480   strcpy (new_name, lock_dir);
 481   lock_dir = new_name;
 482
 483   /* Make sure it ends with a slash.  */
 484   if (lock_dir[strlen (lock_dir) - 1] != '/')
 485     strcat (lock_dir, "/");
 486
 487   superlock_file = (char *) xmalloc ((strlen (lock_dir)
 488                                       + sizeof (SUPERLOCK_NAME)));
 489   strcpy (superlock_file, lock_dir);
 490   strcat (superlock_file, SUPERLOCK_NAME);
 491 #endif
 492 }
 493
 494 syms_of_filelock ()
 495 {
 496   defsubr (&Sunlock_buffer);
 497   defsubr (&Slock_buffer);
 498   defsubr (&Sfile_locked_p);
 499 }
 500
 501 #endif /* CLASH_DETECTION */