filelock.c 19.1 KB
Newer Older
1
/* Lock files for editing.
2
   Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2012
Glenn Morris's avatar
Glenn Morris committed
3
                 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
19 20


21
#include <config.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
22 23
#include <sys/types.h>
#include <sys/stat.h>
Andreas Schwab's avatar
Andreas Schwab committed
24
#include <signal.h>
25
#include <stdio.h>
26
#include <setjmp.h>
Jim Blandy's avatar
Jim Blandy committed
27

28
#ifdef HAVE_PWD_H
Richard M. Stallman's avatar
Richard M. Stallman committed
29
#include <pwd.h>
30
#endif
Jim Blandy's avatar
Jim Blandy committed
31

Richard M. Stallman's avatar
Richard M. Stallman committed
32 33
#include <sys/file.h>
#include <fcntl.h>
Andreas Schwab's avatar
Andreas Schwab committed
34 35
#include <unistd.h>

36 37 38 39
#ifdef __FreeBSD__
#include <sys/sysctl.h>
#endif /* __FreeBSD__ */

40 41
#include <errno.h>

Richard M. Stallman's avatar
Richard M. Stallman committed
42
#include "lisp.h"
Kenichi Handa's avatar
Kenichi Handa committed
43
#include "character.h"
44
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
45
#include "coding.h"
46
#include "systime.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
47 48

#ifdef CLASH_DETECTION
49

50
#ifdef HAVE_UTMP_H
51
#include <utmp.h>
52
#endif
53

Paul Eggert's avatar
Paul Eggert committed
54 55 56 57 58 59
/* A file whose last-modified time is just after the most recent boot.
   Define this to be NULL to disable checking for this file.  */
#ifndef BOOT_TIME_FILE
#define BOOT_TIME_FILE "/var/run/random-seed"
#endif

60 61 62
#ifndef WTMP_FILE
#define WTMP_FILE "/var/log/wtmp"
#endif
63

Richard M. Stallman's avatar
Richard M. Stallman committed
64 65 66 67 68 69
/* The strategy: to lock a file FN, create a symlink .#FN in FN's
   directory, with link data `user@host.pid'.  This avoids a single
   mount (== failure) point for lock files.

   When the host in the lock data is the current host, we can check if
   the pid is valid with kill.
70

Richard M. Stallman's avatar
Richard M. Stallman committed
71 72 73 74 75 76 77
   Otherwise, we could look at a separate file that maps hostnames to
   reboot times to see if the remote pid can possibly be valid, since we
   don't want Emacs to have to communicate via pipes or sockets or
   whatever to other processes, either locally or remotely; rms says
   that's too unreliable.  Hence the separate file, which could
   theoretically be updated by daemons running separately -- but this
   whole idea is unimplemented; in practice, at least in our
Karl Heuer's avatar
Karl Heuer committed
78
   environment, it seems such stale locks arise fairly infrequently, and
Richard M. Stallman's avatar
Richard M. Stallman committed
79 80 81 82 83 84
   Emacs' standard methods of dealing with clashes suffice.

   We use symlinks instead of normal files because (1) they can be
   stored more efficiently on the filesystem, since the kernel knows
   they will be small, and (2) all the info about the lock can be read
   in a single system call (readlink).  Although we could use regular
Karl Heuer's avatar
Karl Heuer committed
85
   files to be useful on old systems lacking symlinks, nowadays
Richard M. Stallman's avatar
Richard M. Stallman committed
86 87
   virtually all such systems are probably single-user anyway, so it
   didn't seem worth the complication.
88

Richard M. Stallman's avatar
Richard M. Stallman committed
89 90 91
   Similarly, we don't worry about a possible 14-character limit on
   file names, because those are all the same systems that don't have
   symlinks.
92

Richard M. Stallman's avatar
Richard M. Stallman committed
93 94 95
   This is compatible with the locking scheme used by Interleaf (which
   has contributed this implementation for Emacs), and was designed by
   Ethan Jacobson, Kimbo Mundy, and others.
96

Richard M. Stallman's avatar
Richard M. Stallman committed
97
   --karl@cs.umb.edu/karl@hq.ileaf.com.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
98

99 100 101 102

/* Return the time of the last system boot.  */

static time_t boot_time;
103
static bool boot_time_initialized;
104

105
#ifdef BOOT_TIME
106
static void get_boot_time_1 (const char *, bool);
107 108
#endif

109
static time_t
110
get_boot_time (void)
111
{
112
#if defined (BOOT_TIME)
113
  int counter;
114
#endif
115

116
  if (boot_time_initialized)
117
    return boot_time;
118
  boot_time_initialized = 1;
119

120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
#if defined (CTL_KERN) && defined (KERN_BOOTTIME)
  {
    int mib[2];
    size_t size;
    struct timeval boottime_val;

    mib[0] = CTL_KERN;
    mib[1] = KERN_BOOTTIME;
    size = sizeof (boottime_val);

    if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
      {
	boot_time = boottime_val.tv_sec;
	return boot_time;
      }
  }
#endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
137

Paul Eggert's avatar
Paul Eggert committed
138 139 140 141 142 143 144 145 146 147
  if (BOOT_TIME_FILE)
    {
      struct stat st;
      if (stat (BOOT_TIME_FILE, &st) == 0)
	{
	  boot_time = st.st_mtime;
	  return boot_time;
	}
    }

148
#if defined (BOOT_TIME)
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
#ifndef CANNOT_DUMP
  /* The utmp routines maintain static state.
     Don't touch that state unless we are initialized,
     since it might not survive dumping.  */
  if (! initialized)
    return boot_time;
#endif /* not CANNOT_DUMP */

  /* Try to get boot time from utmp before wtmp,
     since utmp is typically much smaller than wtmp.
     Passing a null pointer causes get_boot_time_1
     to inspect the default file, namely utmp.  */
  get_boot_time_1 ((char *) 0, 0);
  if (boot_time)
    return boot_time;

165
  /* Try to get boot time from the current wtmp file.  */
166
  get_boot_time_1 (WTMP_FILE, 1);
167 168

  /* If we did not find a boot time in wtmp, look at wtmp, and so on.  */
169
  for (counter = 0; counter < 20 && ! boot_time; counter++)
170
    {
171
      char cmd_string[sizeof WTMP_FILE ".19.gz"];
172
      Lisp_Object tempname, filename;
173
      bool delete_flag = 0;
174 175 176

      filename = Qnil;

177 178
      tempname = make_formatted_string
	(cmd_string, "%s.%d", WTMP_FILE, counter);
179
      if (! NILP (Ffile_exists_p (tempname)))
180 181 182
	filename = tempname;
      else
	{
183 184
	  tempname = make_formatted_string (cmd_string, "%s.%d.gz",
					    WTMP_FILE, counter);
185 186 187
	  if (! NILP (Ffile_exists_p (tempname)))
	    {
	      Lisp_Object args[6];
188 189 190 191 192 193

	      /* The utmp functions on mescaline.gnu.org accept only
		 file names up to 8 characters long.  Choose a 2
		 character long prefix, and call make_temp_file with
		 second arg non-zero, so that it will add not more
		 than 6 characters to the prefix.  */
194
	      filename = Fexpand_file_name (build_string ("wt"),
195
					    Vtemporary_file_directory);
196 197
	      filename = make_temp_name (filename, 1);
	      args[0] = build_string ("gzip");
198
	      args[1] = Qnil;
199
	      args[2] = list2 (QCfile, filename);
200
	      args[3] = Qnil;
201 202
	      args[4] = build_string ("-cd");
	      args[5] = tempname;
203 204 205 206 207 208 209
	      Fcall_process (6, args);
	      delete_flag = 1;
	    }
	}

      if (! NILP (filename))
	{
210
	  get_boot_time_1 (SSDATA (filename), 1);
211
	  if (delete_flag)
212
	    unlink (SSDATA (filename));
213 214 215 216 217 218 219 220 221
	}
    }

  return boot_time;
#else
  return 0;
#endif
}

222
#ifdef BOOT_TIME
223 224 225
/* Try to get the boot time from wtmp file FILENAME.
   This succeeds if that file contains a reboot record.

226 227
   If FILENAME is zero, use the same file as before;
   if no FILENAME has ever been specified, this is the utmp file.
228
   Use the newest reboot record if NEWEST,
229 230 231 232
   the first reboot record otherwise.
   Ignore all reboot records on or before BOOT_TIME.
   Success is indicated by setting BOOT_TIME to a larger value.  */

233
void
234
get_boot_time_1 (const char *filename, bool newest)
235 236
{
  struct utmp ut, *utp;
237 238
  int desc;

239 240 241 242
  if (filename)
    {
      /* On some versions of IRIX, opening a nonexistent file name
	 is likely to crash in the utmp routines.  */
243
      desc = emacs_open (filename, O_RDONLY, 0);
244 245 246
      if (desc < 0)
	return;

247
      emacs_close (desc);
248 249 250

      utmpname (filename);
    }
251

252
  setutent ();
253

254 255 256 257 258 259 260 261 262
  while (1)
    {
      /* Find the next reboot record.  */
      ut.ut_type = BOOT_TIME;
      utp = getutid (&ut);
      if (! utp)
	break;
      /* Compare reboot times and use the newest one.  */
      if (utp->ut_time > boot_time)
263 264 265 266 267
	{
	  boot_time = utp->ut_time;
	  if (! newest)
	    break;
	}
268 269 270 271 272 273
      /* Advance on element in the file
	 so that getutid won't repeat the same one.  */
      utp = getutent ();
      if (! utp)
	break;
    }
274 275
  endutent ();
}
276
#endif /* BOOT_TIME */
Richard M. Stallman's avatar
Richard M. Stallman committed
277 278

/* Here is the structure that stores information about a lock.  */
Jim Blandy's avatar
Jim Blandy committed
279

Richard M. Stallman's avatar
Richard M. Stallman committed
280 281 282 283
typedef struct
{
  char *user;
  char *host;
284
  pid_t pid;
285
  time_t boot_time;
Richard M. Stallman's avatar
Richard M. Stallman committed
286
} lock_info_type;
Jim Blandy's avatar
Jim Blandy committed
287

Richard M. Stallman's avatar
Richard M. Stallman committed
288 289
/* Free the two dynamically-allocated pieces in PTR.  */
#define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
290 291


Richard M. Stallman's avatar
Richard M. Stallman committed
292
/* Write the name of the lock file for FN into LFNAME.  Length will be
293 294 295
   that of FN plus two more for the leading `.#' plus 1 for the
   trailing period plus one for the digit after it plus one for the
   null.  */
296
#define MAKE_LOCK_NAME(lock, file) \
297
  (lock = alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
Richard M. Stallman's avatar
Richard M. Stallman committed
298
   fill_in_lock_file_name (lock, (file)))
299

Richard M. Stallman's avatar
Richard M. Stallman committed
300
static void
301
fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
302
{
303
  ptrdiff_t length = SBYTES (fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
304
  register char *p;
305 306
  struct stat st;
  int count = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
307

308
  strcpy (lockfile, SSDATA (fn));
Richard M. Stallman's avatar
Richard M. Stallman committed
309 310 311 312

  /* Shift the nondirectory part of the file name (including the null)
     right two characters.  Here is one of the places where we'd have to
     do something to support 14-character-max file names.  */
313
  for (p = lockfile + length; p != lockfile && *p != '/'; p--)
Richard M. Stallman's avatar
Richard M. Stallman committed
314
    p[2] = *p;
315

Richard M. Stallman's avatar
Richard M. Stallman committed
316 317 318
  /* Insert the `.#'.  */
  p[1] = '.';
  p[2] = '#';
319

320
  p = p + length + 2;
321 322 323 324 325 326 327 328 329 330

  while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
    {
      if (count > 9)
	{
	  *p = '\0';
	  return;
	}
      sprintf (p, ".%d", count++);
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
331
}
332

Richard M. Stallman's avatar
Richard M. Stallman committed
333
/* Lock the lock file named LFNAME.
334 335
   If FORCE, do so even if it is already locked.
   Return true if successful.  */
336

337 338
static bool
lock_file_1 (char *lfname, bool force)
Richard M. Stallman's avatar
Richard M. Stallman committed
339
{
340
  int err;
341 342
  int symlink_errno;
  USE_SAFE_ALLOCA;
343

344
  /* Call this first because it can GC.  */
345 346 347 348 349 350 351 352 353 354 355
  printmax_t boot = get_boot_time ();

  Lisp_Object luser_name = Fuser_login_name (Qnil);
  char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
  Lisp_Object lhost_name = Fsystem_name ();
  char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : "";
  ptrdiff_t lock_info_size = (strlen (user_name) + strlen (host_name)
			      + 2 * INT_STRLEN_BOUND (printmax_t)
			      + sizeof "@.:");
  char *lock_info_str = SAFE_ALLOCA (lock_info_size);
  printmax_t pid = getpid ();
Richard M. Stallman's avatar
Richard M. Stallman committed
356

357 358
  esprintf (lock_info_str, boot ? "%s@%s.%"pMd":%"pMd : "%s@%s.%"pMd,
	    user_name, host_name, pid, boot);
Richard M. Stallman's avatar
Richard M. Stallman committed
359 360 361

  err = symlink (lock_info_str, lfname);
  if (errno == EEXIST && force)
362
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
363 364
      unlink (lfname);
      err = symlink (lock_info_str, lfname);
365 366
    }

367 368 369
  symlink_errno = errno;
  SAFE_FREE ();
  errno = symlink_errno;
Richard M. Stallman's avatar
Richard M. Stallman committed
370 371
  return err == 0;
}
372

373
/* Return true if times A and B are no more than one second apart.  */
Jim Blandy's avatar
Jim Blandy committed
374

375
static bool
376
within_one_second (time_t a, time_t b)
377 378 379
{
  return (a - b >= -1 && a - b <= 1);
}
Richard M. Stallman's avatar
Richard M. Stallman committed
380 381 382 383 384

/* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
   1 if another process owns it (and set OWNER (if non-null) to info),
   2 if the current process owns it,
   or -1 if something is wrong with the locking mechanism.  */
385

Richard M. Stallman's avatar
Richard M. Stallman committed
386
static int
387
current_lock_owner (lock_info_type *owner, char *lfname)
Jim Blandy's avatar
Jim Blandy committed
388
{
389
  int ret;
390 391 392
  ptrdiff_t len;
  lock_info_type local_owner;
  intmax_t n;
393
  char *at, *dot, *colon;
394 395
  char readlink_buf[READLINK_BUFSIZE];
  char *lfinfo = emacs_readlink (lfname, readlink_buf);
396

Richard M. Stallman's avatar
Richard M. Stallman committed
397
  /* If nonexistent lock file, all is well; otherwise, got strange error. */
398 399
  if (!lfinfo)
    return errno == ENOENT ? 0 : -1;
400

Richard M. Stallman's avatar
Richard M. Stallman committed
401
  /* Even if the caller doesn't want the owner info, we still have to
402
     read it to determine return value.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
403
  if (!owner)
404
    owner = &local_owner;
405

406
  /* Parse USER@HOST.PID:BOOT_TIME.  If can't parse, return -1.  */
407
  /* The USER is everything before the last @.  */
408 409
  at = strrchr (lfinfo, '@');
  dot = strrchr (lfinfo, '.');
410 411
  if (!at || !dot)
    {
412 413
      if (lfinfo != readlink_buf)
	xfree (lfinfo);
414 415
      return -1;
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
416
  len = at - lfinfo;
Dmitry Antipov's avatar
Dmitry Antipov committed
417
  owner->user = xmalloc (len + 1);
418
  memcpy (owner->user, lfinfo, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
419
  owner->user[len] = 0;
420

421
  /* The PID is everything from the last `.' to the `:'.  */
422 423 424 425 426 427 428 429
  errno = 0;
  n = strtoimax (dot + 1, NULL, 10);
  owner->pid =
    ((0 <= n && n <= TYPE_MAXIMUM (pid_t)
      && (TYPE_MAXIMUM (pid_t) < INTMAX_MAX || errno != ERANGE))
     ? n : 0);

  colon = strchr (dot + 1, ':');
430
  /* After the `:', if there is one, comes the boot time.  */
431 432 433 434 435 436 437 438 439 440
  n = 0;
  if (colon)
    {
      errno = 0;
      n = strtoimax (colon + 1, NULL, 10);
    }
  owner->boot_time =
    ((0 <= n && n <= TYPE_MAXIMUM (time_t)
      && (TYPE_MAXIMUM (time_t) < INTMAX_MAX || errno != ERANGE))
     ? n : 0);
Jim Blandy's avatar
Jim Blandy committed
441

Richard M. Stallman's avatar
Richard M. Stallman committed
442 443
  /* The host is everything in between.  */
  len = dot - at - 1;
Dmitry Antipov's avatar
Dmitry Antipov committed
444
  owner->host = xmalloc (len + 1);
445
  memcpy (owner->host, at + 1, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
446
  owner->host[len] = 0;
Jim Blandy's avatar
Jim Blandy committed
447

Richard M. Stallman's avatar
Richard M. Stallman committed
448
  /* We're done looking at the link info.  */
449 450
  if (lfinfo != readlink_buf)
    xfree (lfinfo);
451

Richard M. Stallman's avatar
Richard M. Stallman committed
452
  /* On current host?  */
453
  if (STRINGP (Fsystem_name ())
454
      && strcmp (owner->host, SSDATA (Fsystem_name ())) == 0)
Jim Blandy's avatar
Jim Blandy committed
455
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
456 457
      if (owner->pid == getpid ())
        ret = 2; /* We own it.  */
458
      else if (owner->pid > 0
459 460
               && (kill (owner->pid, 0) >= 0 || errno == EPERM)
	       && (owner->boot_time == 0
461
		   || within_one_second (owner->boot_time, get_boot_time ())))
Richard M. Stallman's avatar
Richard M. Stallman committed
462 463 464
        ret = 1; /* An existing process on this machine owns it.  */
      /* The owner process is dead or has a strange pid (<=0), so try to
         zap the lockfile.  */
465
      else if (unlink (lfname) < 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
466
        ret = -1;
467 468
      else
	ret = 0;
Jim Blandy's avatar
Jim Blandy committed
469
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
470 471 472 473 474
  else
    { /* If we wanted to support the check for stale locks on remote machines,
         here's where we'd do it.  */
      ret = 1;
    }
475

Richard M. Stallman's avatar
Richard M. Stallman committed
476
  /* Avoid garbage.  */
477
  if (owner == &local_owner || ret <= 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
478 479 480 481
    {
      FREE_LOCK_INFO (*owner);
    }
  return ret;
Jim Blandy's avatar
Jim Blandy committed
482 483
}

Richard M. Stallman's avatar
Richard M. Stallman committed
484 485 486 487 488 489

/* Lock the lock named LFNAME if possible.
   Return 0 in that case.
   Return positive if some other process owns the lock, and info about
     that process in CLASHER.
   Return -1 if cannot lock for any other reason.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
490

Richard M. Stallman's avatar
Richard M. Stallman committed
491
static int
492
lock_if_free (lock_info_type *clasher, register char *lfname)
Richard M. Stallman's avatar
Richard M. Stallman committed
493
{
494
  while (! lock_file_1 (lfname, 0))
Richard M. Stallman's avatar
Richard M. Stallman committed
495 496
    {
      int locker;
497

Richard M. Stallman's avatar
Richard M. Stallman committed
498 499
      if (errno != EEXIST)
	return -1;
500

Richard M. Stallman's avatar
Richard M. Stallman committed
501 502 503 504 505 506 507 508
      locker = current_lock_owner (clasher, lfname);
      if (locker == 2)
        {
          FREE_LOCK_INFO (*clasher);
          return 0;   /* We ourselves locked it.  */
        }
      else if (locker == 1)
        return 1;  /* Someone else has it.  */
509
      else if (locker == -1)
Richard M. Stallman's avatar
Richard M. Stallman committed
510
	return -1;   /* current_lock_owner returned strange error.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
511

512
      /* We deleted a stale lock; try again to lock the file.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
513 514
    }
  return 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
515 516
}

Richard M. Stallman's avatar
Richard M. Stallman committed
517
/* lock_file locks file FN,
Richard M. Stallman's avatar
Richard M. Stallman committed
518 519 520
   meaning it serves notice on the world that you intend to edit that file.
   This should be done only when about to modify a file-visiting
   buffer previously unmodified.
Richard M. Stallman's avatar
Richard M. Stallman committed
521
   Do not (normally) call this for a buffer already modified,
Richard M. Stallman's avatar
Richard M. Stallman committed
522 523 524
   as either the file is already locked, or the user has already
   decided to go ahead without locking.

Richard M. Stallman's avatar
Richard M. Stallman committed
525
   When this returns, either the lock is locked for us,
Richard M. Stallman's avatar
Richard M. Stallman committed
526 527
   or the user has said to go ahead without locking.

Richard M. Stallman's avatar
Richard M. Stallman committed
528
   If the file is locked by someone else, this calls
Richard M. Stallman's avatar
Richard M. Stallman committed
529
   ask-user-about-lock (a Lisp function) with two arguments,
Richard M. Stallman's avatar
Richard M. Stallman committed
530
   the file name and info about the user who did the locking.
Richard M. Stallman's avatar
Richard M. Stallman committed
531 532 533 534
   This function can signal an error, or return t meaning
   take away the lock, or return nil meaning ignore the lock.  */

void
535
lock_file (Lisp_Object fn)
Richard M. Stallman's avatar
Richard M. Stallman committed
536
{
Richard M. Stallman's avatar
Richard M. Stallman committed
537
  register Lisp_Object attack, orig_fn, encoded_fn;
Richard M. Stallman's avatar
Richard M. Stallman committed
538
  register char *lfname, *locker;
539
  ptrdiff_t locker_size;
Richard M. Stallman's avatar
Richard M. Stallman committed
540
  lock_info_type lock_info;
541
  printmax_t pid;
Dave Love's avatar
Dave Love committed
542
  struct gcpro gcpro1;
543
  USE_SAFE_ALLOCA;
Richard M. Stallman's avatar
Richard M. Stallman committed
544

545 546 547 548
  /* Don't do locking if the user has opted out.  */
  if (! create_lockfiles)
    return;

549 550 551 552 553 554
  /* Don't do locking while dumping Emacs.
     Uncompressing wtmp files uses call-process, which does not work
     in an uninitialized Emacs.  */
  if (! NILP (Vpurify_flag))
    return;

555
  orig_fn = fn;
Dave Love's avatar
Dave Love committed
556
  GCPRO1 (fn);
557
  fn = Fexpand_file_name (fn, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
558
  encoded_fn = ENCODE_FILE (fn);
559

Richard M. Stallman's avatar
Richard M. Stallman committed
560
  /* Create the name of the lock-file for file fn */
Richard M. Stallman's avatar
Richard M. Stallman committed
561
  MAKE_LOCK_NAME (lfname, encoded_fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
562

Jim Blandy's avatar
Jim Blandy committed
563 564
  /* See if this file is visited and has changed on disk since it was
     visited.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
565
  {
566
    register Lisp_Object subject_buf;
Richard M. Stallman's avatar
Richard M. Stallman committed
567

568
    subject_buf = get_truename_buffer (orig_fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
569

Jim Blandy's avatar
Jim Blandy committed
570 571 572
    if (!NILP (subject_buf)
	&& NILP (Fverify_visited_file_modtime (subject_buf))
	&& !NILP (Ffile_exists_p (fn)))
Richard M. Stallman's avatar
Richard M. Stallman committed
573
      call1 (intern ("ask-user-about-supersession-threat"), fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
574

Richard M. Stallman's avatar
Richard M. Stallman committed
575
  }
Dave Love's avatar
Dave Love committed
576
  UNGCPRO;
Richard M. Stallman's avatar
Richard M. Stallman committed
577 578

  /* Try to lock the lock. */
Richard M. Stallman's avatar
Richard M. Stallman committed
579 580
  if (lock_if_free (&lock_info, lfname) <= 0)
    /* Return now if we have locked it, or if lock creation failed */
Richard M. Stallman's avatar
Richard M. Stallman committed
581 582 583
    return;

  /* Else consider breaking the lock */
584 585 586
  locker_size = (strlen (lock_info.user) + strlen (lock_info.host)
		 + INT_STRLEN_BOUND (printmax_t)
		 + sizeof "@ (pid )");
587
  locker = SAFE_ALLOCA (locker_size);
588
  pid = lock_info.pid;
589 590
  esprintf (locker, "%s@%s (pid %"pMd")",
	    lock_info.user, lock_info.host, pid);
Richard M. Stallman's avatar
Richard M. Stallman committed
591
  FREE_LOCK_INFO (lock_info);
592

Richard M. Stallman's avatar
Richard M. Stallman committed
593
  attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
594
  SAFE_FREE ();
Jim Blandy's avatar
Jim Blandy committed
595
  if (!NILP (attack))
Richard M. Stallman's avatar
Richard M. Stallman committed
596 597
    /* User says take the lock */
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
598
      lock_file_1 (lfname, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
599 600 601 602 603 604
      return;
    }
  /* User says ignore the lock */
}

void
605
unlock_file (register Lisp_Object fn)
Richard M. Stallman's avatar
Richard M. Stallman committed
606 607 608
{
  register char *lfname;

609
  fn = Fexpand_file_name (fn, Qnil);
610
  fn = ENCODE_FILE (fn);
611

612
  MAKE_LOCK_NAME (lfname, fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
613

Richard M. Stallman's avatar
Richard M. Stallman committed
614
  if (current_lock_owner (0, lfname) == 2)
Richard M. Stallman's avatar
Richard M. Stallman committed
615 616 617 618
    unlink (lfname);
}

void
619
unlock_all_files (void)
Richard M. Stallman's avatar
Richard M. Stallman committed
620 621 622 623
{
  register Lisp_Object tail;
  register struct buffer *b;

624
  for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
Richard M. Stallman's avatar
Richard M. Stallman committed
625
    {
626
      b = XBUFFER (XCDR (XCAR (tail)));
Tom Tromey's avatar
Tom Tromey committed
627
      if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
628
	{
Juanma Barranquero's avatar
Juanma Barranquero committed
629
	  unlock_file (BVAR (b, file_truename));
630
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
631 632 633 634
    }
}

DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
635 636 637 638
       0, 1, 0,
       doc: /* Lock FILE, if current buffer is modified.
FILE defaults to current buffer's visited file,
or else nothing is done if current buffer isn't visiting a file.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
639
  (Lisp_Object file)
Richard M. Stallman's avatar
Richard M. Stallman committed
640
{
641
  if (NILP (file))
Tom Tromey's avatar
Tom Tromey committed
642
    file = BVAR (current_buffer, file_truename);
Richard M. Stallman's avatar
Richard M. Stallman committed
643
  else
644
    CHECK_STRING (file);
645
  if (SAVE_MODIFF < MODIFF
646 647
      && !NILP (file))
    lock_file (file);
648
  return Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
649 650
}

Paul Eggert's avatar
Paul Eggert committed
651
DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
652
       0, 0, 0,
653 654 655
       doc: /* Unlock the file visited in the current buffer.
If the buffer is not modified, this does nothing because the file
should not be locked in that case.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
656
  (void)
Richard M. Stallman's avatar
Richard M. Stallman committed
657
{
658
  if (SAVE_MODIFF < MODIFF
Tom Tromey's avatar
Tom Tromey committed
659 660
      && STRINGP (BVAR (current_buffer, file_truename)))
    unlock_file (BVAR (current_buffer, file_truename));
Richard M. Stallman's avatar
Richard M. Stallman committed
661 662 663 664 665
  return Qnil;
}

/* Unlock the file visited in buffer BUFFER.  */

666
void
667
unlock_buffer (struct buffer *buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
668
{
669
  if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
Tom Tromey's avatar
Tom Tromey committed
670 671
      && STRINGP (BVAR (buffer, file_truename)))
    unlock_file (BVAR (buffer, file_truename));
Richard M. Stallman's avatar
Richard M. Stallman committed
672 673
}

674
DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
675 676 677
       doc: /* Return a value indicating whether FILENAME is locked.
The value is nil if the FILENAME is not locked,
t if it is locked by you, else a string saying which user has locked it.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
678
  (Lisp_Object filename)
Richard M. Stallman's avatar
Richard M. Stallman committed
679
{
Richard M. Stallman's avatar
Richard M. Stallman committed
680
  Lisp_Object ret;
Richard M. Stallman's avatar
Richard M. Stallman committed
681 682
  register char *lfname;
  int owner;
Richard M. Stallman's avatar
Richard M. Stallman committed
683
  lock_info_type locker;
Richard M. Stallman's avatar
Richard M. Stallman committed
684

685
  filename = Fexpand_file_name (filename, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
686

687
  MAKE_LOCK_NAME (lfname, filename);
Richard M. Stallman's avatar
Richard M. Stallman committed
688

Richard M. Stallman's avatar
Richard M. Stallman committed
689
  owner = current_lock_owner (&locker, lfname);
Richard M. Stallman's avatar
Richard M. Stallman committed
690
  if (owner <= 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
691 692 693 694 695 696 697 698 699 700
    ret = Qnil;
  else if (owner == 2)
    ret = Qt;
  else
    ret = build_string (locker.user);

  if (owner > 0)
    FREE_LOCK_INFO (locker);

  return ret;
Richard M. Stallman's avatar
Richard M. Stallman committed
701
}
Karl Heuer's avatar
Karl Heuer committed
702

703 704
#endif /* CLASH_DETECTION */

Andreas Schwab's avatar
Andreas Schwab committed
705
void
706
syms_of_filelock (void)
Richard M. Stallman's avatar
Richard M. Stallman committed
707
{
708
  DEFVAR_LISP ("temporary-file-directory", Vtemporary_file_directory,
709
	       doc: /* The directory for writing temporary files.  */);
710 711
  Vtemporary_file_directory = Qnil;

712 713 714 715
  DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
	       doc: /* Non-nil means use lockfiles to avoid editing collisions.  */);
  create_lockfiles = 1;

716
#ifdef CLASH_DETECTION
Richard M. Stallman's avatar
Richard M. Stallman committed
717 718 719
  defsubr (&Sunlock_buffer);
  defsubr (&Slock_buffer);
  defsubr (&Sfile_locked_p);
720
#endif
Richard M. Stallman's avatar
Richard M. Stallman committed
721
}