src/filelock.c

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