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