src/filelock.c

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