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