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
 357   for (i = -20; i < 0 && (fd = open (superlock_file,
 358                                      O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
 359        i++)
 360     {
 361       if (errno != EEXIST)
 362         return;
 363
 364       /* This seems to be necessary to prevent Emacs from hanging when the
 365          competing process has already deleted the superlock, but it's still
 366          in the NFS cache.  So we force NFS to synchronize the cache.  */
 367       if (lockdir = opendir (lock_dir))
 368         closedir (lockdir);
 369
 370       sleep (1);
 371     }
 372   if (fd >= 0)
 373     {
 374 #ifdef USG
 375       chmod (superlock_file, 0666);
 376 #else
 377       fchmod (fd, 0666);
 378 #endif
 379       write (fd, lfname, strlen (lfname));
 380       close (fd);
 381     }
 382 }
 383
 384 void
 385 unlock_all_files ()
 386 {
 387   register Lisp_Object tail;
 388   register struct buffer *b;
 389
 390   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
 391     {
 392       b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
 393       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 394         unlock_file (b->file_truename);
 395     }
 396 }
 397
 398 \f
 399 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 400   0, 1, 0,
 401   "Lock FILE, if current buffer is modified.\n\
 402 FILE defaults to current buffer's visited file,\n\
 403 or else nothing is done if current buffer isn't visiting a file.")
 404   (file)
 405      Lisp_Object file;
 406 {
 407   if (NILP (file))
 408     file = current_buffer->file_truename;
 409   else
 410     CHECK_STRING (file, 0);
 411   if (SAVE_MODIFF < MODIFF
 412       && !NILP (file))
 413     lock_file (file);
 414   return Qnil;
 415 }
 416
 417 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 418   0, 0, 0,
 419  "Unlock the file visited in the current buffer,\n\
 420 if it should normally be locked.")
 421   ()
 422 {
 423   if (SAVE_MODIFF < MODIFF
 424       && STRINGP (current_buffer->file_truename))
 425     unlock_file (current_buffer->file_truename);
 426   return Qnil;
 427 }
 428
 429 \f
 430 /* Unlock the file visited in buffer BUFFER.  */
 431
 432 unlock_buffer (buffer)
 433      struct buffer *buffer;
 434 {
 435   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 436       && STRINGP (buffer->file_truename))
 437     unlock_file (buffer->file_truename);
 438 }
 439
 440 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
 441   "Return nil if the FILENAME is not locked,\n\
 442 t if it is locked by you, else a string of the name of the locker.")
 443   (filename)
 444   Lisp_Object filename;
 445 {
 446   register char *lfname;
 447   int owner;
 448
 449   filename = Fexpand_file_name (filename, Qnil);
 450
 451   MAKE_LOCK_NAME (lfname, filename);
 452
 453   owner = current_lock_owner (lfname);
 454   if (owner <= 0)
 455     return (Qnil);
 456   else if (owner == getpid ())
 457     return (Qt);
 458
 459   return (lock_file_owner_name (lfname));
 460 }
 461
 462 \f
 463 /* Initialization functions.  */
 464
 465 init_filelock ()
 466 {
 467   char *new_name;
 468
 469   lock_dir = egetenv ("EMACSLOCKDIR");
 470   if (! lock_dir)
 471     lock_dir = PATH_LOCK;
 472
 473   /* Copy the name in case egetenv got it from a Lisp string.  */
 474   new_name = (char *) xmalloc (strlen (lock_dir) + 2);
 475   strcpy (new_name, lock_dir);
 476   lock_dir = new_name;
 477
 478   /* Make sure it ends with a slash.  */
 479   if (lock_dir[strlen (lock_dir) - 1] != '/')
 480     strcat (lock_dir, "/");
 481
 482   superlock_file = (char *) xmalloc ((strlen (lock_dir)
 483                                       + sizeof (SUPERLOCK_NAME)));
 484   strcpy (superlock_file, lock_dir);
 485   strcat (superlock_file, SUPERLOCK_NAME);
 486 }
 487
 488 syms_of_filelock ()
 489 {
 490   defsubr (&Sunlock_buffer);
 491   defsubr (&Slock_buffer);
 492   defsubr (&Sfile_locked_p);
 493 }
 494
 495 #endif /* CLASH_DETECTION */