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