code.delx.au - gnu-emacs/blob - 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   else
 170     the_pw = 0;
 171
 172   return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
 173 }
 174
 175
 176 /* lock_file locks file fn,
 177    meaning it serves notice on the world that you intend to edit that file.
 178    This should be done only when about to modify a file-visiting
 179    buffer previously unmodified.
 180    Do not (normally) call lock_buffer for a buffer already modified,
 181    as either the file is already locked, or the user has already
 182    decided to go ahead without locking.
 183
 184    When lock_buffer returns, either the lock is locked for us,
 185    or the user has said to go ahead without locking.
 186
 187    If the file is locked by someone else, lock_buffer calls
 188    ask-user-about-lock (a Lisp function) with two arguments,
 189    the file name and the name of the user who did the locking.
 190    This function can signal an error, or return t meaning
 191    take away the lock, or return nil meaning ignore the lock.  */
 192
 193 /* The lock file name is the file name with "/" replaced by "!"
 194    and put in the Emacs lock directory.  */
 195 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
 196
 197 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
 198    representation of a 14-bytes CRC generated from the file name
 199    and put in the Emacs lock directory (not very nice, but it works).
 200    (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
 201
 202 void
 203 lock_file (fn)
 204      register Lisp_Object fn;
 205 {
 206   register Lisp_Object attack, orig_fn;
 207   register char *lfname;
 208
 209   orig_fn = fn;
 210   fn = Fexpand_file_name (fn, Qnil);
 211
 212   MAKE_LOCK_NAME (lfname, fn);
 213
 214   /* See if this file is visited and has changed on disk since it was
 215      visited.  */
 216   {
 217     register Lisp_Object subject_buf;
 218     subject_buf = get_truename_buffer (orig_fn);
 219     if (!NILP (subject_buf)
 220         && NILP (Fverify_visited_file_modtime (subject_buf))
 221         && !NILP (Ffile_exists_p (fn)))
 222       call1 (intern ("ask-user-about-supersession-threat"), fn);
 223   }
 224
 225   /* Try to lock the lock. */
 226   if (lock_if_free (lfname) <= 0)
 227     /* Return now if we have locked it, or if lock dir does not exist */
 228     return;
 229
 230   /* Else consider breaking the lock */
 231   attack = call2 (intern ("ask-user-about-lock"), fn,
 232                   lock_file_owner_name (lfname));
 233   if (!NILP (attack))
 234     /* User says take the lock */
 235     {
 236       lock_superlock (lfname);
 237       lock_file_1 (lfname, O_WRONLY) ;
 238       unlink (superlock_file);
 239       return;
 240     }
 241   /* User says ignore the lock */
 242 }
 243
 244 /* Lock the lock file named LFNAME.
 245    If MODE is O_WRONLY, we do so even if it is already locked.
 246    If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
 247    Return 1 if successful, 0 if not.  */
 248
 249 int
 250 lock_file_1 (lfname, mode)
 251      int mode; char *lfname;
 252 {
 253   register int fd;
 254   char buf[20];
 255
 256   if ((fd = open (lfname, mode, 0666)) >= 0)
 257     {
 258 #ifdef USG
 259       chmod (lfname, 0666);
 260 #else
 261       fchmod (fd, 0666);
 262 #endif
 263       sprintf (buf, "%d ", getpid ());
 264       write (fd, buf, strlen (buf));
 265       close (fd);
 266       return 1;
 267     }
 268   else
 269     return 0;
 270 }
 271
 272 /* Lock the lock named LFNAME if possible.
 273    Return 0 in that case.
 274    Return positive if lock is really locked by someone else.
 275    Return -1 if cannot lock for any other reason.  */
 276
 277 int
 278 lock_if_free (lfname)
 279      register char *lfname;
 280 {
 281   register int clasher;
 282
 283   while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
 284     {
 285       if (errno != EEXIST)
 286         return -1;
 287       clasher = current_lock_owner (lfname);
 288       if (clasher != 0)
 289         if (clasher != getpid ())
 290           return (clasher);
 291         else return (0);
 292       /* Try again to lock it */
 293     }
 294   return 0;
 295 }
 296
 297 /* Return the pid of the process that claims to own the lock file LFNAME,
 298    or 0 if nobody does or the lock is obsolete,
 299    or -1 if something is wrong with the locking mechanism.  */
 300
 301 int
 302 current_lock_owner (lfname)
 303      char *lfname;
 304 {
 305   int owner = current_lock_owner_1 (lfname);
 306   if (owner == 0 && errno == ENOENT)
 307     return (0);
 308   /* Is it locked by a process that exists?  */
 309   if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
 310     return (owner);
 311   if (unlink (lfname) < 0)
 312     return (-1);
 313   return (0);
 314 }
 315
 316 int
 317 current_lock_owner_1 (lfname)
 318      char *lfname;
 319 {
 320   register int fd;
 321   char buf[20];
 322   int tem;
 323
 324   fd = open (lfname, O_RDONLY, 0666);
 325   if (fd < 0)
 326     return 0;
 327   tem = read (fd, buf, sizeof buf);
 328   close (fd);
 329   return (tem <= 0 ? 0 : atoi (buf));
 330 }
 331
 332 \f
 333 void
 334 unlock_file (fn)
 335      register Lisp_Object fn;
 336 {
 337   register char *lfname;
 338
 339   fn = Fexpand_file_name (fn, Qnil);
 340
 341   MAKE_LOCK_NAME (lfname, fn);
 342
 343   lock_superlock (lfname);
 344
 345   if (current_lock_owner_1 (lfname) == getpid ())
 346     unlink (lfname);
 347
 348   unlink (superlock_file);
 349 }
 350
 351 lock_superlock (lfname)
 352      char *lfname;
 353 {
 354   register int i, fd;
 355   DIR *lockdir;
 356   struct stat first_stat, last_stat;
 357
 358   for (i = -20; i < 0;
 359        i++)
 360     {
 361       fd = open (superlock_file,
 362                  O_WRONLY | O_EXCL | O_CREAT, 0666);
 363
 364       /* If we succeeded in creating the superlock, we win.
 365          Fill in our info and return.  */
 366       if (fd >= 0)
 367         {
 368 #ifdef USG
 369           chmod (superlock_file, 0666);
 370 #else
 371           fchmod (fd, 0666);
 372 #endif
 373           write (fd, lfname, strlen (lfname));
 374           close (fd);
 375           return;
 376         }
 377
 378       /* If the problem is not just that it is already locked,
 379          give up.  */
 380       if (errno != EEXIST)
 381         return;
 382
 383       message ("Superlock file exists, retrying...");
 384
 385       if (i == -20)
 386         stat (superlock_file, &first_stat);
 387
 388       if (i == -1)
 389         stat (superlock_file, &last_stat);
 390
 391       /* This seems to be necessary to prevent Emacs from hanging when the
 392          competing process has already deleted the superlock, but it's still
 393          in the NFS cache.  So we force NFS to synchronize the cache.  */
 394       lockdir = opendir (lock_dir);
 395
 396       if (lockdir)
 397         closedir (lockdir);
 398
 399       sleep (1);
 400     }
 401
 402   if (first_stat.st_ctime == last_stat.st_ctime)
 403     {
 404       int value;
 405       value = unlink (superlock_file);
 406
 407       if (value != -1)
 408         message ("Superlock file deleted");
 409       else
 410         message ("Failed to delete superlock file");
 411     }
 412   else
 413     message ("Giving up on the superlock file");
 414 }
 415
 416 void
 417 unlock_all_files ()
 418 {
 419   register Lisp_Object tail;
 420   register struct buffer *b;
 421
 422   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
 423     {
 424       b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
 425       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 426         unlock_file (b->file_truename);
 427     }
 428 }
 429
 430 \f
 431 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 432   0, 1, 0,
 433   "Lock FILE, if current buffer is modified.\n\
 434 FILE defaults to current buffer's visited file,\n\
 435 or else nothing is done if current buffer isn't visiting a file.")
 436   (file)
 437      Lisp_Object file;
 438 {
 439   if (NILP (file))
 440     file = current_buffer->file_truename;
 441   else
 442     CHECK_STRING (file, 0);
 443   if (SAVE_MODIFF < MODIFF
 444       && !NILP (file))
 445     lock_file (file);
 446   return Qnil;
 447 }
 448
 449 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 450   0, 0, 0,
 451  "Unlock the file visited in the current buffer,\n\
 452 if it should normally be locked.")
 453   ()
 454 {
 455   if (SAVE_MODIFF < MODIFF
 456       && STRINGP (current_buffer->file_truename))
 457     unlock_file (current_buffer->file_truename);
 458   return Qnil;
 459 }
 460
 461 \f
 462 /* Unlock the file visited in buffer BUFFER.  */
 463
 464 unlock_buffer (buffer)
 465      struct buffer *buffer;
 466 {
 467   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 468       && STRINGP (buffer->file_truename))
 469     unlock_file (buffer->file_truename);
 470 }
 471
 472 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
 473   "Return nil if the FILENAME is not locked,\n\
 474 t if it is locked by you, else a string of the name of the locker.")
 475   (filename)
 476   Lisp_Object filename;
 477 {
 478   register char *lfname;
 479   int owner;
 480
 481   filename = Fexpand_file_name (filename, Qnil);
 482
 483   MAKE_LOCK_NAME (lfname, filename);
 484
 485   owner = current_lock_owner (lfname);
 486   if (owner <= 0)
 487     return (Qnil);
 488   else if (owner == getpid ())
 489     return (Qt);
 490
 491   return (lock_file_owner_name (lfname));
 492 }
 493
 494 \f
 495 /* Initialization functions.  */
 496
 497 init_filelock ()
 498 {
 499   char *new_name;
 500
 501   lock_dir = egetenv ("EMACSLOCKDIR");
 502   if (! lock_dir)
 503     lock_dir = PATH_LOCK;
 504
 505   /* Copy the name in case egetenv got it from a Lisp string.  */
 506   new_name = (char *) xmalloc (strlen (lock_dir) + 2);
 507   strcpy (new_name, lock_dir);
 508   lock_dir = new_name;
 509
 510   /* Make sure it ends with a slash.  */
 511   if (lock_dir[strlen (lock_dir) - 1] != '/')
 512     strcat (lock_dir, "/");
 513
 514   superlock_file = (char *) xmalloc ((strlen (lock_dir)
 515                                       + sizeof (SUPERLOCK_NAME)));
 516   strcpy (superlock_file, lock_dir);
 517   strcat (superlock_file, SUPERLOCK_NAME);
 518 }
 519
 520 syms_of_filelock ()
 521 {
 522   defsubr (&Sunlock_buffer);
 523   defsubr (&Slock_buffer);
 524   defsubr (&Sfile_locked_p);
 525 }
 526
 527 #endif /* CLASH_DETECTION */