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