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