src/filelock.c

   1 /* Copyright (C) 1985, 1986, 1987, 1993, 1994 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
  30
  31 #include <errno.h>
  32 #include <sys/file.h>
  33 #ifdef USG
  34 #include <fcntl.h>
  35 #endif /* USG */
  36
  37 #include "lisp.h"
  38 #include <paths.h>
  39 #include "buffer.h"
  40
  41 #ifdef SYSV_SYSTEM_DIR
  42 #include <dirent.h>
  43 #else /* not SYSV_SYSTEM_DIR */
  44 #ifdef NONSYSTEM_DIR_LIBRARY
  45 #include "ndir.h"
  46 #else /* not NONSYSTEM_DIR_LIBRARY */
  47 #ifdef MSDOS
  48 #include <dirent.h>
  49 #else
  50 #include <sys/dir.h>
  51 #endif
  52 #endif /* not NONSYSTEM_DIR_LIBRARY */
  53 #ifndef MSDOS
  54 extern DIR *opendir ();
  55 #endif /* not MSDOS */
  56 #endif /* not SYSV_SYSTEM_DIR */
  57
  58 extern int errno;
  59
  60 extern char *egetenv ();
  61 extern char *strcpy ();
  62
  63 #ifdef DECLARE_GETPWUID_WITH_UID_T
  64 extern struct passwd *getpwuid (uid_t);
  65 #else
  66 extern struct passwd *getpwuid ();
  67 #endif
  68
  69 #ifdef CLASH_DETECTION
  70
  71 /* If system does not have symbolic links, it does not have lstat.
  72    In that case, use ordinary stat instead.  */
  73
  74 #ifndef S_IFLNK
  75 #define lstat stat
  76 #endif
  77
  78
  79 /* The name of the directory in which we keep lock files, with a '/'
  80    appended.  */
  81 char *lock_dir;
  82
  83 /* The name of the file in the lock directory which is used to
  84    arbitrate access to the entire directory.  */
  85 #define SUPERLOCK_NAME "!!!SuperLock!!!"
  86
  87 /* The name of the superlock file.  This is SUPERLOCK_NAME appended to
  88    lock_dir.  */
  89 char *superlock_file;
  90
  91 /* Set LOCK to the name of the lock file for the filename FILE.
  92    char *LOCK; Lisp_Object FILE;  */
  93
  94 #ifndef HAVE_LONG_FILE_NAMES
  95
  96 #define MAKE_LOCK_NAME(lock, file) \
  97   (lock = (char *) alloca (14 + strlen (lock_dir) + 1), \
  98    fill_in_lock_short_file_name (lock, (file)))
  99
 100
 101 fill_in_lock_short_file_name (lockfile, fn)
 102      register char *lockfile;
 103      register Lisp_Object fn;
 104 {
 105   register union
 106     {
 107       unsigned int  word [2];
 108       unsigned char byte [8];
 109     } crc;
 110   register unsigned char *p, new;
 111
 112   /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
 113      the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
 114
 115   crc.word[0] = crc.word[1] = 0;
 116
 117   for (p = XSTRING (fn)->data; new = *p++; )
 118     {
 119       new += crc.byte[6];
 120       crc.byte[6] = crc.byte[5] + new;
 121       crc.byte[5] = crc.byte[4];
 122       crc.byte[4] = crc.byte[3];
 123       crc.byte[3] = crc.byte[2] + new;
 124       crc.byte[2] = crc.byte[1];
 125       crc.byte[1] = crc.byte[0];
 126       crc.byte[0] = new;
 127     }
 128   sprintf (lockfile, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_dir,
 129            crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3],
 130            crc.byte[4], crc.byte[5], crc.byte[6]);
 131 }
 132
 133 #else /* defined HAVE_LONG_FILE_NAMES */
 134
 135 #define MAKE_LOCK_NAME(lock, file) \
 136   (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_dir) + 1), \
 137    fill_in_lock_file_name (lock, (file)))
 138
 139
 140 fill_in_lock_file_name (lockfile, fn)
 141      register char *lockfile;
 142      register Lisp_Object fn;
 143 {
 144   register char *p;
 145
 146   strcpy (lockfile, lock_dir);
 147
 148   p = lockfile + strlen (lockfile);
 149
 150   strcpy (p, XSTRING (fn)->data);
 151
 152   for (; *p; p++)
 153     {
 154       if (*p == '/')
 155         *p = '!';
 156     }
 157 }
 158 #endif /* !defined HAVE_LONG_FILE_NAMES */
 159
 160 static Lisp_Object
 161 lock_file_owner_name (lfname)
 162      char *lfname;
 163 {
 164   struct stat s;
 165   struct passwd *the_pw;
 166
 167   if (lstat (lfname, &s) == 0)
 168     the_pw = getpwuid (s.st_uid);
 169   return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
 170 }
 171
 172
 173 /* lock_file locks file fn,
 174    meaning it serves notice on the world that you intend to edit that file.
 175    This should be done only when about to modify a file-visiting
 176    buffer previously unmodified.
 177    Do not (normally) call lock_buffer for a buffer already modified,
 178    as either the file is already locked, or the user has already
 179    decided to go ahead without locking.
 180
 181    When lock_buffer returns, either the lock is locked for us,
 182    or the user has said to go ahead without locking.
 183
 184    If the file is locked by someone else, lock_buffer calls
 185    ask-user-about-lock (a Lisp function) with two arguments,
 186    the file name and the name of the user who did the locking.
 187    This function can signal an error, or return t meaning
 188    take away the lock, or return nil meaning ignore the lock.  */
 189
 190 /* The lock file name is the file name with "/" replaced by "!"
 191    and put in the Emacs lock directory.  */
 192 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
 193
 194 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
 195    representation of a 14-bytes CRC generated from the file name
 196    and put in the Emacs lock directory (not very nice, but it works).
 197    (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
 198
 199 void
 200 lock_file (fn)
 201      register Lisp_Object fn;
 202 {
 203   register Lisp_Object attack, orig_fn;
 204   register char *lfname;
 205
 206   orig_fn = fn;
 207   fn = Fexpand_file_name (fn, Qnil);
 208
 209   MAKE_LOCK_NAME (lfname, fn);
 210
 211   /* See if this file is visited and has changed on disk since it was
 212      visited.  */
 213   {
 214     register Lisp_Object subject_buf;
 215     subject_buf = get_truename_buffer (orig_fn);
 216     if (!NILP (subject_buf)
 217         && NILP (Fverify_visited_file_modtime (subject_buf))
 218         && !NILP (Ffile_exists_p (fn)))
 219       call1 (intern ("ask-user-about-supersession-threat"), fn);
 220   }
 221
 222   /* Try to lock the lock. */
 223   if (lock_if_free (lfname) <= 0)
 224     /* Return now if we have locked it, or if lock dir does not exist */
 225     return;
 226
 227   /* Else consider breaking the lock */
 228   attack = call2 (intern ("ask-user-about-lock"), fn,
 229                   lock_file_owner_name (lfname));
 230   if (!NILP (attack))
 231     /* User says take the lock */
 232     {
 233       lock_superlock (lfname);
 234       lock_file_1 (lfname, O_WRONLY) ;
 235       unlink (superlock_file);
 236       return;
 237     }
 238   /* User says ignore the lock */
 239 }
 240
 241 /* Lock the lock file named LFNAME.
 242    If MODE is O_WRONLY, we do so even if it is already locked.
 243    If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
 244    Return 1 if successful, 0 if not.  */
 245
 246 int
 247 lock_file_1 (lfname, mode)
 248      int mode; char *lfname;
 249 {
 250   register int fd;
 251   char buf[20];
 252
 253   if ((fd = open (lfname, mode, 0666)) >= 0)
 254     {
 255 #ifdef USG
 256       chmod (lfname, 0666);
 257 #else
 258       fchmod (fd, 0666);
 259 #endif
 260       sprintf (buf, "%d ", getpid ());
 261       write (fd, buf, strlen (buf));
 262       close (fd);
 263       return 1;
 264     }
 265   else
 266     return 0;
 267 }
 268
 269 /* Lock the lock named LFNAME if possible.
 270    Return 0 in that case.
 271    Return positive if lock is really locked by someone else.
 272    Return -1 if cannot lock for any other reason.  */
 273
 274 int
 275 lock_if_free (lfname)
 276      register char *lfname;
 277 {
 278   register int clasher;
 279
 280   while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
 281     {
 282       if (errno != EEXIST)
 283         return -1;
 284       clasher = current_lock_owner (lfname);
 285       if (clasher != 0)
 286         if (clasher != getpid ())
 287           return (clasher);
 288         else return (0);
 289       /* Try again to lock it */
 290     }
 291   return 0;
 292 }
 293
 294 /* Return the pid of the process that claims to own the lock file LFNAME,
 295    or 0 if nobody does or the lock is obsolete,
 296    or -1 if something is wrong with the locking mechanism.  */
 297
 298 int
 299 current_lock_owner (lfname)
 300      char *lfname;
 301 {
 302   int owner = current_lock_owner_1 (lfname);
 303   if (owner == 0 && errno == ENOENT)
 304     return (0);
 305   /* Is it locked by a process that exists?  */
 306   if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
 307     return (owner);
 308   if (unlink (lfname) < 0)
 309     return (-1);
 310   return (0);
 311 }
 312
 313 int
 314 current_lock_owner_1 (lfname)
 315      char *lfname;
 316 {
 317   register int fd;
 318   char buf[20];
 319   int tem;
 320
 321   fd = open (lfname, O_RDONLY, 0666);
 322   if (fd < 0)
 323     return 0;
 324   tem = read (fd, buf, sizeof buf);
 325   close (fd);
 326   return (tem <= 0 ? 0 : atoi (buf));
 327 }
 328
 329 \f
 330 void
 331 unlock_file (fn)
 332      register Lisp_Object fn;
 333 {
 334   register char *lfname;
 335
 336   fn = Fexpand_file_name (fn, Qnil);
 337
 338   MAKE_LOCK_NAME (lfname, fn);
 339
 340   lock_superlock (lfname);
 341
 342   if (current_lock_owner_1 (lfname) == getpid ())
 343     unlink (lfname);
 344
 345   unlink (superlock_file);
 346 }
 347
 348 lock_superlock (lfname)
 349      char *lfname;
 350 {
 351   register int i, fd;
 352   DIR *lockdir;
 353
 354   for (i = -20; i < 0 && (fd = open (superlock_file,
 355                                      O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
 356        i++)
 357     {
 358       if (errno != EEXIST)
 359         return;
 360
 361       /* This seems to be necessary to prevent Emacs from hanging when the
 362          competing process has already deleted the superlock, but it's still
 363          in the NFS cache.  So we force NFS to synchronize the cache.  */
 364       if (lockdir = opendir (lock_dir))
 365         closedir (lockdir);
 366
 367       sleep (1);
 368     }
 369   if (fd >= 0)
 370     {
 371 #ifdef USG
 372       chmod (superlock_file, 0666);
 373 #else
 374       fchmod (fd, 0666);
 375 #endif
 376       write (fd, lfname, strlen (lfname));
 377       close (fd);
 378     }
 379 }
 380
 381 void
 382 unlock_all_files ()
 383 {
 384   register Lisp_Object tail;
 385   register struct buffer *b;
 386
 387   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
 388     {
 389       b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
 390       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 391         unlock_file (b->file_truename);
 392     }
 393 }
 394
 395 \f
 396 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 397   0, 1, 0,
 398   "Lock FILE, if current buffer is modified.\n\
 399 FILE defaults to current buffer's visited file,\n\
 400 or else nothing is done if current buffer isn't visiting a file.")
 401   (file)
 402      Lisp_Object file;
 403 {
 404   if (NILP (file))
 405     file = current_buffer->file_truename;
 406   else
 407     CHECK_STRING (file, 0);
 408   if (SAVE_MODIFF < MODIFF
 409       && !NILP (file))
 410     lock_file (file);
 411   return Qnil;
 412 }
 413
 414 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 415   0, 0, 0,
 416  "Unlock the file visited in the current buffer,\n\
 417 if it should normally be locked.")
 418   ()
 419 {
 420   if (SAVE_MODIFF < MODIFF
 421       && STRINGP (current_buffer->file_truename))
 422     unlock_file (current_buffer->file_truename);
 423   return Qnil;
 424 }
 425
 426 \f
 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   register char *lfname;
 444   int owner;
 445
 446   filename = Fexpand_file_name (filename, Qnil);
 447
 448   MAKE_LOCK_NAME (lfname, filename);
 449
 450   owner = current_lock_owner (lfname);
 451   if (owner <= 0)
 452     return (Qnil);
 453   else if (owner == getpid ())
 454     return (Qt);
 455
 456   return (lock_file_owner_name (lfname));
 457 }
 458
 459 \f
 460 /* Initialization functions.  */
 461
 462 init_filelock ()
 463 {
 464   char *new_name;
 465
 466   lock_dir = egetenv ("EMACSLOCKDIR");
 467   if (! lock_dir)
 468     lock_dir = PATH_LOCK;
 469
 470   /* Copy the name in case egetenv got it from a Lisp string.  */
 471   new_name = (char *) xmalloc (strlen (lock_dir) + 2);
 472   strcpy (new_name, lock_dir);
 473   lock_dir = new_name;
 474
 475   /* Make sure it ends with a slash.  */
 476   if (lock_dir[strlen (lock_dir) - 1] != '/')
 477     strcat (lock_dir, "/");
 478
 479   superlock_file = (char *) xmalloc ((strlen (lock_dir)
 480                                       + sizeof (SUPERLOCK_NAME)));
 481   strcpy (superlock_file, lock_dir);
 482   strcat (superlock_file, SUPERLOCK_NAME);
 483 }
 484
 485 syms_of_filelock ()
 486 {
 487   defsubr (&Sunlock_buffer);
 488   defsubr (&Slock_buffer);
 489   defsubr (&Sfile_locked_p);
 490 }
 491
 492 #endif /* CLASH_DETECTION */