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