src/filelock.c

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