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, 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 #ifdef 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_dir;
  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 name of the superlock file.  This is SUPERLOCK_NAME appended to
  87    lock_dir.  */
  88 char *superlock_file;
  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_NAME(lock, file) \
  96   (lock = (char *) alloca (14 + strlen (lock_dir) + 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_dir,
 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_NAME(lock, file) \
 135   (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_dir) + 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_dir);
 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, orig_fn;
 203   register char *lfname;
 204
 205   orig_fn = fn;
 206   fn = Fexpand_file_name (fn, Qnil);
 207
 208   MAKE_LOCK_NAME (lfname, fn);
 209
 210   /* See if this file is visited and has changed on disk since it was
 211      visited.  */
 212   {
 213     register Lisp_Object subject_buf;
 214     subject_buf = get_truename_buffer (orig_fn);
 215     if (!NILP (subject_buf)
 216         && NILP (Fverify_visited_file_modtime (subject_buf))
 217         && !NILP (Ffile_exists_p (fn)))
 218       call1 (intern ("ask-user-about-supersession-threat"), fn);
 219   }
 220
 221   /* Try to lock the lock. */
 222   if (lock_if_free (lfname) <= 0)
 223     /* Return now if we have locked it, or if lock dir does not exist */
 224     return;
 225
 226   /* Else consider breaking the lock */
 227   attack = call2 (intern ("ask-user-about-lock"), fn,
 228                   lock_file_owner_name (lfname));
 229   if (!NILP (attack))
 230     /* User says take the lock */
 231     {
 232       lock_superlock (lfname);
 233       lock_file_1 (lfname, O_WRONLY) ;
 234       unlink (superlock_file);
 235       return;
 236     }
 237   /* User says ignore the lock */
 238 }
 239
 240 /* Lock the lock file named LFNAME.
 241    If MODE is O_WRONLY, we do so even if it is already locked.
 242    If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
 243    Return 1 if successful, 0 if not.  */
 244
 245 int
 246 lock_file_1 (lfname, mode)
 247      int mode; char *lfname;
 248 {
 249   register int fd;
 250   char buf[20];
 251
 252   if ((fd = open (lfname, mode, 0666)) >= 0)
 253     {
 254 #ifdef USG
 255       chmod (lfname, 0666);
 256 #else
 257       fchmod (fd, 0666);
 258 #endif
 259       sprintf (buf, "%d ", getpid ());
 260       write (fd, buf, strlen (buf));
 261       close (fd);
 262       return 1;
 263     }
 264   else
 265     return 0;
 266 }
 267
 268 /* Lock the lock named LFNAME if possible.
 269    Return 0 in that case.
 270    Return positive if lock is really locked by someone else.
 271    Return -1 if cannot lock for any other reason.  */
 272
 273 int
 274 lock_if_free (lfname)
 275      register char *lfname;
 276 {
 277   register int clasher;
 278
 279   while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
 280     {
 281       if (errno != EEXIST)
 282         return -1;
 283       clasher = current_lock_owner (lfname);
 284       if (clasher != 0)
 285         if (clasher != getpid ())
 286           return (clasher);
 287         else return (0);
 288       /* Try again to lock it */
 289     }
 290   return 0;
 291 }
 292
 293 /* Return the pid of the process that claims to own the lock file LFNAME,
 294    or 0 if nobody does or the lock is obsolete,
 295    or -1 if something is wrong with the locking mechanism.  */
 296
 297 int
 298 current_lock_owner (lfname)
 299      char *lfname;
 300 {
 301   int owner = current_lock_owner_1 (lfname);
 302   if (owner == 0 && errno == ENOENT)
 303     return (0);
 304   /* Is it locked by a process that exists?  */
 305   if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
 306     return (owner);
 307   if (unlink (lfname) < 0)
 308     return (-1);
 309   return (0);
 310 }
 311
 312 int
 313 current_lock_owner_1 (lfname)
 314      char *lfname;
 315 {
 316   register int fd;
 317   char buf[20];
 318   int tem;
 319
 320   fd = open (lfname, O_RDONLY, 0666);
 321   if (fd < 0)
 322     return 0;
 323   tem = read (fd, buf, sizeof buf);
 324   close (fd);
 325   return (tem <= 0 ? 0 : atoi (buf));
 326 }
 327
 328 \f
 329 void
 330 unlock_file (fn)
 331      register Lisp_Object fn;
 332 {
 333   register char *lfname;
 334
 335   fn = Fexpand_file_name (fn, Qnil);
 336
 337   MAKE_LOCK_NAME (lfname, fn);
 338
 339   lock_superlock (lfname);
 340
 341   if (current_lock_owner_1 (lfname) == getpid ())
 342     unlink (lfname);
 343
 344   unlink (superlock_file);
 345 }
 346
 347 lock_superlock (lfname)
 348      char *lfname;
 349 {
 350   register int i, fd;
 351   DIR *lockdir;
 352
 353   for (i = -20; i < 0 && (fd = open (superlock_file,
 354                                      O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
 355        i++)
 356     {
 357       if (errno != EEXIST)
 358         return;
 359
 360       /* This seems to be necessary to prevent Emacs from hanging when the
 361          competing process has already deleted the superlock, but it's still
 362          in the NFS cache.  So we force NFS to synchronize the cache.  */
 363       if (lockdir = opendir (lock_dir))
 364         closedir (lockdir);
 365
 366       sleep (1);
 367     }
 368   if (fd >= 0)
 369     {
 370 #ifdef USG
 371       chmod (superlock_file, 0666);
 372 #else
 373       fchmod (fd, 0666);
 374 #endif
 375       write (fd, lfname, strlen (lfname));
 376       close (fd);
 377     }
 378 }
 379
 380 void
 381 unlock_all_files ()
 382 {
 383   register Lisp_Object tail;
 384   register struct buffer *b;
 385
 386   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
 387     {
 388       b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
 389       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 390         unlock_file (b->file_truename);
 391     }
 392 }
 393
 394 \f
 395 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 396   0, 1, 0,
 397   "Lock FILE, if current buffer is modified.\n\
 398 FILE defaults to current buffer's visited file,\n\
 399 or else nothing is done if current buffer isn't visiting a file.")
 400   (fn)
 401      Lisp_Object fn;
 402 {
 403   if (NILP (fn))
 404     fn = current_buffer->file_truename;
 405   else
 406     CHECK_STRING (fn, 0);
 407   if (SAVE_MODIFF < MODIFF
 408       && !NILP (fn))
 409     lock_file (fn);
 410   return Qnil;
 411 }
 412
 413 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 414   0, 0, 0,
 415  "Unlock the file visited in the current buffer,\n\
 416 if it should normally be locked.")
 417   ()
 418 {
 419   if (SAVE_MODIFF < MODIFF
 420       && STRINGP (current_buffer->file_truename))
 421     unlock_file (current_buffer->file_truename);
 422   return Qnil;
 423 }
 424
 425 \f
 426 /* Unlock the file visited in buffer BUFFER.  */
 427
 428 unlock_buffer (buffer)
 429      struct buffer *buffer;
 430 {
 431   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 432       && STRINGP (buffer->file_truename))
 433     unlock_file (buffer->file_truename);
 434 }
 435
 436 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
 437   "Return nil if the FILENAME is not locked,\n\
 438 t if it is locked by you, else a string of the name of the locker.")
 439   (fn)
 440   Lisp_Object fn;
 441 {
 442   register char *lfname;
 443   int owner;
 444
 445   fn = Fexpand_file_name (fn, Qnil);
 446
 447   MAKE_LOCK_NAME (lfname, fn);
 448
 449   owner = current_lock_owner (lfname);
 450   if (owner <= 0)
 451     return (Qnil);
 452   else if (owner == getpid ())
 453     return (Qt);
 454
 455   return (lock_file_owner_name (lfname));
 456 }
 457
 458 \f
 459 /* Initialization functions.  */
 460
 461 init_filelock ()
 462 {
 463   char *new_name;
 464
 465   lock_dir = egetenv ("EMACSLOCKDIR");
 466   if (! lock_dir)
 467     lock_dir = PATH_LOCK;
 468
 469   /* Copy the name in case egetenv got it from a Lisp string.  */
 470   new_name = (char *) xmalloc (strlen (lock_dir) + 2);
 471   strcpy (new_name, lock_dir);
 472   lock_dir = new_name;
 473
 474   /* Make sure it ends with a slash.  */
 475   if (lock_dir[strlen (lock_dir) - 1] != '/')
 476     strcat (lock_dir, "/");
 477
 478   superlock_file = (char *) xmalloc ((strlen (lock_dir)
 479                                       + sizeof (SUPERLOCK_NAME)));
 480   strcpy (superlock_file, lock_dir);
 481   strcat (superlock_file, SUPERLOCK_NAME);
 482 }
 483
 484 syms_of_filelock ()
 485 {
 486   defsubr (&Sunlock_buffer);
 487   defsubr (&Slock_buffer);
 488   defsubr (&Sfile_locked_p);
 489 }
 490
 491 #endif /* CLASH_DETECTION */