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