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 = (char *) XSTRING (Fuser_login_name (Qnil))->data;
 137   char *host_name = (char *) XSTRING (Fsystem_name ())->data;
 138   char *lock_info_str = alloca (strlen (user_name) + strlen (host_name)
 139                                 + LOCK_PID_MAX + 5);
 140
 141   sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
 142            (unsigned long) getpid ());
 143
 144   err = symlink (lock_info_str, lfname);
 145   if (errno == EEXIST && force)
 146     {
 147       unlink (lfname);
 148       err = symlink (lock_info_str, lfname);
 149     }
 150
 151   return err == 0;
 152 }
 153
 154
 155 \f
 156 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
 157    1 if another process owns it (and set OWNER (if non-null) to info),
 158    2 if the current process owns it,
 159    or -1 if something is wrong with the locking mechanism.  */
 160
 161 static int
 162 current_lock_owner (owner, lfname)
 163      lock_info_type *owner;
 164      char *lfname;
 165 {
 166 #ifndef index
 167   extern char *rindex (), *index ();
 168 #endif
 169   int o, p, len, ret;
 170   int local_owner = 0;
 171   char *at, *dot;
 172   char *lfinfo = 0;
 173   int bufsize = 50;
 174   /* Read arbitrarily-long contents of symlink.  Similar code in
 175      file-symlink-p in fileio.c.  */
 176   do
 177     {
 178       bufsize *= 2;
 179       lfinfo = (char *) xrealloc (lfinfo, bufsize);
 180       len = readlink (lfname, lfinfo, bufsize);
 181     }
 182   while (len >= bufsize);
 183
 184   /* If nonexistent lock file, all is well; otherwise, got strange error. */
 185   if (len == -1)
 186     {
 187       xfree (lfinfo);
 188       return errno == ENOENT ? 0 : -1;
 189     }
 190
 191   /* Link info exists, so `len' is its length.  Null terminate.  */
 192   lfinfo[len] = 0;
 193
 194   /* Even if the caller doesn't want the owner info, we still have to
 195      read it to determine return value, so allocate it.  */
 196   if (!owner)
 197     {
 198       owner = (lock_info_type *) alloca (sizeof (lock_info_type));
 199       local_owner = 1;
 200     }
 201
 202   /* Parse USER@HOST.PID.  If can't parse, return -1.  */
 203   /* The USER is everything before the first @.  */
 204   at = index (lfinfo, '@');
 205   dot = rindex (lfinfo, '.');
 206   if (!at || !dot) {
 207     xfree (lfinfo);
 208     return -1;
 209   }
 210   len = at - lfinfo;
 211   owner->user = (char *) xmalloc (len + 1);
 212   strncpy (owner->user, lfinfo, len);
 213   owner->user[len] = 0;
 214
 215   /* The PID is everything after the last `.'.  */
 216   owner->pid = atoi (dot + 1);
 217
 218   /* The host is everything in between.  */
 219   len = dot - at - 1;
 220   owner->host = (char *) xmalloc (len + 1);
 221   strncpy (owner->host, at + 1, len);
 222   owner->host[len] = 0;
 223
 224   /* We're done looking at the link info.  */
 225   xfree (lfinfo);
 226
 227   /* On current host?  */
 228   if (strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
 229     {
 230       if (owner->pid == getpid ())
 231         ret = 2; /* We own it.  */
 232
 233       if (owner->pid > 0
 234                && (kill (owner->pid, 0) >= 0 || errno == EPERM))
 235         ret = 1; /* An existing process on this machine owns it.  */
 236
 237       /* The owner process is dead or has a strange pid (<=0), so try to
 238          zap the lockfile.  */
 239       if (unlink (lfname) < 0)
 240         ret = -1;
 241
 242       ret = 0;
 243     }
 244   else
 245     { /* If we wanted to support the check for stale locks on remote machines,
 246          here's where we'd do it.  */
 247       ret = 1;
 248     }
 249
 250   /* Avoid garbage.  */
 251   if (local_owner || ret <= 0)
 252     {
 253       FREE_LOCK_INFO (*owner);
 254     }
 255   return ret;
 256 }
 257
 258 \f
 259 /* Lock the lock named LFNAME if possible.
 260    Return 0 in that case.
 261    Return positive if some other process owns the lock, and info about
 262      that process in CLASHER.
 263    Return -1 if cannot lock for any other reason.  */
 264
 265 static int
 266 lock_if_free (clasher, lfname)
 267      lock_info_type *clasher;
 268      register char *lfname;
 269 {
 270   while (lock_file_1 (lfname, 0) == 0)
 271     {
 272       int locker;
 273
 274       if (errno != EEXIST)
 275         return -1;
 276
 277       locker = current_lock_owner (clasher, lfname);
 278       if (locker == 2)
 279         {
 280           FREE_LOCK_INFO (*clasher);
 281           return 0;   /* We ourselves locked it.  */
 282         }
 283       else if (locker == 1)
 284         return 1;  /* Someone else has it.  */
 285       else if (locker == -1)
 286         return -1; /* Something's wrong.  */
 287
 288        /* If some other error, or no such lock, try to lock again.  */
 289        /* Is there a case where we loop forever?  */
 290     }
 291   return 0;
 292 }
 293
 294 /* lock_file locks file FN,
 295    meaning it serves notice on the world that you intend to edit that file.
 296    This should be done only when about to modify a file-visiting
 297    buffer previously unmodified.
 298    Do not (normally) call this for a buffer already modified,
 299    as either the file is already locked, or the user has already
 300    decided to go ahead without locking.
 301
 302    When this returns, either the lock is locked for us,
 303    or the user has said to go ahead without locking.
 304
 305    If the file is locked by someone else, this calls
 306    ask-user-about-lock (a Lisp function) with two arguments,
 307    the file name and info about the user who did the locking.
 308    This function can signal an error, or return t meaning
 309    take away the lock, or return nil meaning ignore the lock.  */
 310
 311 void
 312 lock_file (fn)
 313     register Lisp_Object fn;
 314 {
 315   register Lisp_Object attack, orig_fn;
 316   register char *lfname, *locker;
 317   lock_info_type lock_info;
 318
 319   orig_fn = fn;
 320   fn = Fexpand_file_name (fn, Qnil);
 321
 322   /* Create the name of the lock-file for file fn */
 323   MAKE_LOCK_NAME (lfname, fn);
 324
 325   /* See if this file is visited and has changed on disk since it was
 326      visited.  */
 327   {
 328     register Lisp_Object subject_buf;
 329     subject_buf = get_truename_buffer (orig_fn);
 330     if (!NILP (subject_buf)
 331         && NILP (Fverify_visited_file_modtime (subject_buf))
 332         && !NILP (Ffile_exists_p (fn)))
 333       call1 (intern ("ask-user-about-supersession-threat"), fn);
 334   }
 335
 336   /* Try to lock the lock. */
 337   if (lock_if_free (&lock_info, lfname) <= 0)
 338     /* Return now if we have locked it, or if lock creation failed */
 339     return;
 340
 341   /* Else consider breaking the lock */
 342   locker = alloca (strlen (lock_info.user) + strlen (lock_info.host)
 343                    + LOCK_PID_MAX + 9);
 344   sprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
 345            lock_info.pid);
 346   FREE_LOCK_INFO (lock_info);
 347
 348   attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
 349   if (!NILP (attack))
 350     /* User says take the lock */
 351     {
 352       lock_file_1 (lfname, 1);
 353       return;
 354     }
 355   /* User says ignore the lock */
 356 }
 357
 358 void
 359 unlock_file (fn)
 360      register Lisp_Object fn;
 361 {
 362   register char *lfname;
 363
 364   fn = Fexpand_file_name (fn, Qnil);
 365
 366   MAKE_LOCK_NAME (lfname, fn);
 367
 368   if (current_lock_owner (0, lfname) == 2)
 369     unlink (lfname);
 370 }
 371
 372 void
 373 unlock_all_files ()
 374 {
 375   register Lisp_Object tail;
 376   register struct buffer *b;
 377
 378   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
 379     {
 380       b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
 381       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 382         unlock_file (b->file_truename);
 383     }
 384 }
 385 \f
 386 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 387   0, 1, 0,
 388   "Lock FILE, if current buffer is modified.\n\
 389 FILE defaults to current buffer's visited file,\n\
 390 or else nothing is done if current buffer isn't visiting a file.")
 391   (file)
 392      Lisp_Object file;
 393 {
 394   if (NILP (file))
 395     file = current_buffer->file_truename;
 396   else
 397     CHECK_STRING (file, 0);
 398   if (SAVE_MODIFF < MODIFF
 399       && !NILP (file))
 400     lock_file (file);
 401   return Qnil;
 402 }
 403
 404 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 405   0, 0, 0,
 406  "Unlock the file visited in the current buffer,\n\
 407 if it should normally be locked.")
 408   ()
 409 {
 410   if (SAVE_MODIFF < MODIFF
 411       && STRINGP (current_buffer->file_truename))
 412     unlock_file (current_buffer->file_truename);
 413   return Qnil;
 414 }
 415
 416 /* Unlock the file visited in buffer BUFFER.  */
 417
 418 unlock_buffer (buffer)
 419      struct buffer *buffer;
 420 {
 421   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 422       && STRINGP (buffer->file_truename))
 423     unlock_file (buffer->file_truename);
 424 }
 425
 426 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
 427   "Return nil if the FILENAME is not locked,\n\
 428 t if it is locked by you, else a string of the name of the locker.")
 429   (filename)
 430   Lisp_Object filename;
 431 {
 432   Lisp_Object ret;
 433   register char *lfname;
 434   int owner;
 435   lock_info_type locker;
 436
 437   filename = Fexpand_file_name (filename, Qnil);
 438
 439   MAKE_LOCK_NAME (lfname, filename);
 440
 441   owner = current_lock_owner (&locker, lfname);
 442   if (owner <= 0)
 443     ret = Qnil;
 444   else if (owner == 2)
 445     ret = Qt;
 446   else
 447     ret = build_string (locker.user);
 448
 449   if (owner > 0)
 450     FREE_LOCK_INFO (locker);
 451
 452   return ret;
 453 }
 454
 455 \f
 456 /* Initialization functions.  */
 457
 458 init_filelock ()
 459 {
 460 #if 0
 461   char *new_name;
 462
 463   lock_dir = egetenv ("EMACSLOCKDIR");
 464   if (! lock_dir)
 465     lock_dir = PATH_LOCK;
 466
 467   /* Copy the name in case egetenv got it from a Lisp string.  */
 468   new_name = (char *) xmalloc (strlen (lock_dir) + 2);
 469   strcpy (new_name, lock_dir);
 470   lock_dir = new_name;
 471
 472   /* Make sure it ends with a slash.  */
 473   if (lock_dir[strlen (lock_dir) - 1] != '/')
 474     strcat (lock_dir, "/");
 475
 476   superlock_file = (char *) xmalloc ((strlen (lock_dir)
 477                                       + sizeof (SUPERLOCK_NAME)));
 478   strcpy (superlock_file, lock_dir);
 479   strcat (superlock_file, SUPERLOCK_NAME);
 480 #endif
 481 }
 482
 483 syms_of_filelock ()
 484 {
 485   defsubr (&Sunlock_buffer);
 486   defsubr (&Slock_buffer);
 487   defsubr (&Sfile_locked_p);
 488 }
 489
 490 #endif /* CLASH_DETECTION */