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