filelock.c 26 KB
Newer Older
1
/* Lock files for editing.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2021 Free Software
Paul Eggert's avatar
Paul Eggert committed
4
Foundation, Inc.
5 6 7

Author: Richard King
  (according to authors.el)
Richard M. Stallman's avatar
Richard M. Stallman committed
8 9 10

This file is part of GNU Emacs.

11
GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
12
it under the terms of the GNU General Public License as published by
13 14
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
15 16 17 18 19 20 21

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
22
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
23 24


25
#include <config.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
26 27
#include <sys/types.h>
#include <sys/stat.h>
Andreas Schwab's avatar
Andreas Schwab committed
28
#include <signal.h>
29
#include <stdio.h>
Paul Eggert's avatar
Paul Eggert committed
30
#include <stdlib.h>
Jim Blandy's avatar
Jim Blandy committed
31

32
#ifdef HAVE_PWD_H
Richard M. Stallman's avatar
Richard M. Stallman committed
33
#include <pwd.h>
34
#endif
Jim Blandy's avatar
Jim Blandy committed
35

Richard M. Stallman's avatar
Richard M. Stallman committed
36 37
#include <sys/file.h>
#include <fcntl.h>
Andreas Schwab's avatar
Andreas Schwab committed
38 39
#include <unistd.h>

40 41 42 43
#ifdef __FreeBSD__
#include <sys/sysctl.h>
#endif /* __FreeBSD__ */

44 45
#include <errno.h>

46 47
#include <c-ctype.h>

Richard M. Stallman's avatar
Richard M. Stallman committed
48
#include "lisp.h"
49
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
50
#include "coding.h"
51
#ifdef WINDOWSNT
52
#include <share.h>
53
#include <sys/socket.h>	/* for fcntl */
54
#endif
Richard M. Stallman's avatar
Richard M. Stallman committed
55

Eli Zaretskii's avatar
Eli Zaretskii committed
56 57
#ifndef MSDOS

58
#ifdef HAVE_UTMP_H
59
#include <utmp.h>
60
#endif
61

Paul Eggert's avatar
Paul Eggert committed
62 63 64 65 66 67
/* 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

68
#if !defined WTMP_FILE && !defined WINDOWSNT
69 70
#define WTMP_FILE "/var/log/wtmp"
#endif
71

72
/* Normally use a symbolic link to represent a lock.
73
   The strategy: to lock a file FN, create a symlink .#FN in FN's
74 75 76
   directory, with link data USER@HOST.PID:BOOT.  This avoids a single
   mount (== failure) point for lock files.  The :BOOT is omitted if
   the boot time is not available.
Richard M. Stallman's avatar
Richard M. Stallman committed
77 78 79

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

Richard M. Stallman's avatar
Richard M. Stallman committed
81 82 83 84 85 86 87
   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
88
   environment, it seems such stale locks arise fairly infrequently, and
Richard M. Stallman's avatar
Richard M. Stallman committed
89 90 91 92 93 94
   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
95
   files to be useful on old systems lacking symlinks, nowadays
Richard M. Stallman's avatar
Richard M. Stallman committed
96 97
   virtually all such systems are probably single-user anyway, so it
   didn't seem worth the complication.
98

Richard M. Stallman's avatar
Richard M. Stallman committed
99 100 101
   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.
102

Richard M. Stallman's avatar
Richard M. Stallman committed
103 104
   This is compatible with the locking scheme used by Interleaf (which
   has contributed this implementation for Emacs), and was designed by
105
   Karl Berry, Ethan Jacobson, Kimbo Mundy, and others.
106

107
   On some file systems, notably those of MS-Windows, symbolic links
108 109
   do not work well, so instead of a symlink .#FN -> USER@HOST.PID:BOOT,
   the lock is a regular file .#FN with contents USER@HOST.PID:BOOT.  To
110 111 112 113 114 115 116 117 118 119 120 121
   establish a lock, a nonce file is created and then renamed to .#FN.
   On MS-Windows this renaming is atomic unless the lock is forcibly
   acquired.  On other systems the renaming is atomic if the lock is
   forcibly acquired; if not, the renaming is done via hard links,
   which is good enough for lock-file purposes.

   To summarize, race conditions can occur with either:

   * Forced locks on MS-Windows systems.

   * Non-forced locks on non-MS-Windows systems that support neither
     hard nor symbolic links.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
122

123 124 125 126

/* Return the time of the last system boot.  */

static time_t boot_time;
127
static bool boot_time_initialized;
128

129
#ifdef BOOT_TIME
130
static void get_boot_time_1 (const char *, bool);
131 132
#endif

133
static time_t
134
get_boot_time (void)
135
{
136
#if defined (BOOT_TIME)
137
  int counter;
138
#endif
139

140
  if (boot_time_initialized)
141
    return boot_time;
142
  boot_time_initialized = 1;
143

144 145 146 147 148 149 150 151 152 153
#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);

154
    if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0 && size != 0)
155 156 157 158 159 160
      {
	boot_time = boottime_val.tv_sec;
	return boot_time;
      }
  }
#endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
161

Paul Eggert's avatar
Paul Eggert committed
162 163 164 165 166 167 168 169 170 171
  if (BOOT_TIME_FILE)
    {
      struct stat st;
      if (stat (BOOT_TIME_FILE, &st) == 0)
	{
	  boot_time = st.st_mtime;
	  return boot_time;
	}
    }

172
#if defined (BOOT_TIME)
Daniel Colascione's avatar
Daniel Colascione committed
173 174 175
  /* The utmp routines maintain static state.  Don't touch that state
     if we are going to dump, since it might not survive dumping.  */
  if (will_dump_p ())
176 177 178 179 180 181
    return boot_time;

  /* 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.  */
Paul Eggert's avatar
Paul Eggert committed
182
  get_boot_time_1 (0, 0);
183 184 185
  if (boot_time)
    return boot_time;

186
  /* Try to get boot time from the current wtmp file.  */
187
  get_boot_time_1 (WTMP_FILE, 1);
188 189

  /* If we did not find a boot time in wtmp, look at wtmp, and so on.  */
190
  for (counter = 0; counter < 20 && ! boot_time; counter++)
191
    {
192 193
      Lisp_Object filename = Qnil;
      bool delete_flag = false;
194
      char cmd_string[sizeof WTMP_FILE ".19.gz"];
195 196
      AUTO_STRING_WITH_LEN (tempname, cmd_string,
			    sprintf (cmd_string, "%s.%d", WTMP_FILE, counter));
197
      if (! NILP (Ffile_exists_p (tempname)))
198 199 200
	filename = tempname;
      else
	{
201 202
	  tempname = make_formatted_string (cmd_string, "%s.%d.gz",
					    WTMP_FILE, counter);
203 204
	  if (! NILP (Ffile_exists_p (tempname)))
	    {
205 206 207 208
	      /* The utmp functions on older systems accept only file
		 names up to 8 bytes long.  Choose a 2 byte prefix, so
		 the 6-byte suffix does not make the name too long.  */
	      filename = Fmake_temp_file_internal (build_string ("wt"), Qnil,
209
						   empty_unibyte_string, Qnil);
210 211 212
	      CALLN (Fcall_process, build_string ("gzip"), Qnil,
		     list2 (QCfile, filename), Qnil,
		     build_string ("-cd"), tempname);
213
	      delete_flag = true;
214 215 216 217 218
	    }
	}

      if (! NILP (filename))
	{
219
	  get_boot_time_1 (SSDATA (filename), 1);
220
	  if (delete_flag)
221
	    unlink (SSDATA (filename));
222 223 224 225 226 227 228 229 230
	}
    }

  return boot_time;
#else
  return 0;
#endif
}

231
#ifdef BOOT_TIME
232 233 234
/* Try to get the boot time from wtmp file FILENAME.
   This succeeds if that file contains a reboot record.

235 236
   If FILENAME is zero, use the same file as before;
   if no FILENAME has ever been specified, this is the utmp file.
237
   Use the newest reboot record if NEWEST,
238 239 240 241
   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.  */

242
void
243
get_boot_time_1 (const char *filename, bool newest)
244 245
{
  struct utmp ut, *utp;
246

247
  if (filename)
Paul Eggert's avatar
Paul Eggert committed
248
    utmpname (filename);
249

250
  setutent ();
251

252 253 254 255 256 257 258 259 260
  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)
261 262 263 264 265
	{
	  boot_time = utp->ut_time;
	  if (! newest)
	    break;
	}
266 267 268 269 270 271
      /* Advance on element in the file
	 so that getutid won't repeat the same one.  */
      utp = getutent ();
      if (! utp)
	break;
    }
272 273
  endutent ();
}
274
#endif /* BOOT_TIME */
Richard M. Stallman's avatar
Richard M. Stallman committed
275

276 277 278 279
/* An arbitrary limit on lock contents length.  8 K should be plenty
   big enough in practice.  */
enum { MAX_LFINFO = 8 * 1024 };

Richard M. Stallman's avatar
Richard M. Stallman committed
280
/* Here is the structure that stores information about a lock.  */
Jim Blandy's avatar
Jim Blandy committed
281

Richard M. Stallman's avatar
Richard M. Stallman committed
282 283
typedef struct
{
284 285
  /* Location of '@', '.', and ':' (or equivalent) in USER.  If there's
     no colon or equivalent, COLON points to the end of USER.  */
286
  char *at, *dot, *colon;
287

288 289 290 291 292 293 294
  /* Lock file contents USER@HOST.PID with an optional :BOOT_TIME
     appended.  This memory is used as a lock file contents buffer, so
     it needs room for MAX_LFINFO + 1 bytes.  A string " (pid NNNN)"
     may be appended to the USER@HOST while generating a diagnostic,
     so make room for its extra bytes (as opposed to ".NNNN") too.  */
  char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
} lock_info_type;
295

296 297 298 299 300 301 302 303 304 305
/* For some reason Linux kernels return EPERM on file systems that do
   not support hard or symbolic links.  This symbol documents the quirk.
   There is no way to tell whether a symlink call fails due to
   permissions issues or because links are not supported, but luckily
   the lock file code should work either way.  */
enum { LINKS_MIGHT_NOT_WORK = EPERM };

/* Rename OLD to NEW.  If FORCE, replace any existing NEW.
   It is OK if there are temporarily two hard links to OLD.
   Return 0 if successful, -1 (setting errno) otherwise.  */
306
static int
307
rename_lock_file (char const *old, char const *new, bool force)
308 309
{
#ifdef WINDOWSNT
310 311 312 313 314
  return sys_rename_replace (old, new, force);
#else
  if (! force)
    {
      struct stat st;
315

316 317 318
      int r = renameat_noreplace (AT_FDCWD, old, AT_FDCWD, new);
      if (! (r < 0 && errno == ENOSYS))
	return r;
319 320 321 322 323 324 325 326 327 328 329
      if (link (old, new) == 0)
	return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
      if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)
	return -1;

      /* 'link' does not work on this file system.  This can occur on
	 a GNU/Linux host mounting a FAT32 file system.  Fall back on
	 'rename' after checking that NEW does not exist.  There is a
	 potential race condition since some other process may create
	 NEW immediately after the existence check, but it's the best
	 we can portably do here.  */
330 331
      if (emacs_fstatat (AT_FDCWD, new, &st, AT_SYMLINK_NOFOLLOW) == 0
	  || errno == EOVERFLOW)
332 333 334 335 336 337 338 339 340 341 342 343
	{
	  errno = EEXIST;
	  return -1;
	}
      if (errno != ENOENT)
	return -1;
    }

  return rename (old, new);
#endif
}

344
/* Create the lock file LFNAME with contents LOCK_INFO_STR.  Return 0 if
345
   successful, an errno value on failure.  If FORCE, remove any
346
   existing LFNAME if necessary.  */
347 348 349 350 351 352 353 354 355 356

static int
create_lock_file (char *lfname, char *lock_info_str, bool force)
{
#ifdef WINDOWSNT
  /* Symlinks are supported only by later versions of Windows, and
     creating them is a privileged operation that often triggers
     User Account Control elevation prompts.  Avoid the problem by
     pretending that 'symlink' does not work.  */
  int err = ENOSYS;
357
#else
358 359 360 361
  int err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
#endif

  if (err == EEXIST && force)
362 363
    {
      unlink (lfname);
364
      err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
365
    }
366 367 368 369 370 371 372 373 374 375 376 377

  if (err == ENOSYS || err == LINKS_MIGHT_NOT_WORK || err == ENAMETOOLONG)
    {
      static char const nonce_base[] = ".#-emacsXXXXXX";
      char *last_slash = strrchr (lfname, '/');
      ptrdiff_t lfdirlen = last_slash + 1 - lfname;
      USE_SAFE_ALLOCA;
      char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base);
      int fd;
      memcpy (nonce, lfname, lfdirlen);
      strcpy (nonce + lfdirlen, nonce_base);

378
      fd = mkostemp (nonce, O_BINARY | O_CLOEXEC);
379 380 381 382
      if (fd < 0)
	err = errno;
      else
	{
383 384
	  ptrdiff_t lock_info_len;
	  lock_info_len = strlen (lock_info_str);
385
	  err = 0;
386 387 388 389 390

	  /* Make the lock file readable to others, so that others' sessions
	     can read it.  Even though nobody should write to the lock file,
	     keep it user-writable to work around problems on nonstandard file
	     systems that prohibit unlinking readonly files (Bug#37884).  */
Paul Eggert's avatar
Paul Eggert committed
391
	  if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
392
	      || fchmod (fd, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH) != 0)
393
	    err = errno;
394

395 396
	  /* There is no need to call fsync here, as the contents of
	     the lock file need not survive system crashes.  */
397 398 399 400 401 402 403 404 405 406 407
	  if (emacs_close (fd) != 0)
	    err = errno;
	  if (!err && rename_lock_file (nonce, lfname, force) != 0)
	    err = errno;
	  if (err)
	    unlink (nonce);
	}

      SAFE_FREE ();
    }

408 409 410
  return err;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
411
/* Lock the lock file named LFNAME.
412
   If FORCE, do so even if it is already locked.
413
   Return 0 if successful, an error number on failure.  */
414

415
static int
416
lock_file_1 (char *lfname, bool force)
Richard M. Stallman's avatar
Richard M. Stallman committed
417
{
418
  /* Call this first because it can GC.  */
Paul Eggert's avatar
Paul Eggert committed
419
  intmax_t boot = get_boot_time ();
420 421 422 423 424

  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) : "";
425
  char lock_info_str[MAX_LFINFO + 1];
Paul Eggert's avatar
Paul Eggert committed
426
  intmax_t pid = getpid ();
Richard M. Stallman's avatar
Richard M. Stallman committed
427

428 429 430 431
  if (boot)
    {
      if (sizeof lock_info_str
          <= snprintf (lock_info_str, sizeof lock_info_str,
Paul Eggert's avatar
Paul Eggert committed
432
		       "%s@%s.%"PRIdMAX":%"PRIdMAX,
433 434 435 436 437
                       user_name, host_name, pid, boot))
        return ENAMETOOLONG;
    }
  else if (sizeof lock_info_str
           <= snprintf (lock_info_str, sizeof lock_info_str,
Paul Eggert's avatar
Paul Eggert committed
438
			"%s@%s.%"PRIdMAX,
439
                        user_name, host_name, pid))
440
    return ENAMETOOLONG;
441

442
  return create_lock_file (lfname, lock_info_str, force);
Richard M. Stallman's avatar
Richard M. Stallman committed
443
}
444

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

447
static bool
448
within_one_second (time_t a, time_t b)
449 450 451
{
  return (a - b >= -1 && a - b <= 1);
}
Richard M. Stallman's avatar
Richard M. Stallman committed
452

453 454 455 456
/* On systems lacking ELOOP, test for an errno value that shouldn't occur.  */
#ifndef ELOOP
# define ELOOP (-1)
#endif
457

458 459 460
/* Read the data for the lock file LFNAME into LFINFO.  Read at most
   MAX_LFINFO + 1 bytes.  Return the number of bytes read, or -1
   (setting errno) on error.  */
461

462 463 464 465
static ptrdiff_t
read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
{
  ptrdiff_t nbytes;
466

467 468
  while ((nbytes = readlinkat (AT_FDCWD, lfname, lfinfo, MAX_LFINFO + 1)) < 0
	 && errno == EINVAL)
469
    {
Paul Eggert's avatar
Paul Eggert committed
470
      int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
Paul Eggert's avatar
Paul Eggert committed
471
      if (0 <= fd)
472
	{
Paul Eggert's avatar
Paul Eggert committed
473
	  ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
474 475 476 477 478 479 480 481 482 483 484 485 486
	  int read_errno = errno;
	  if (emacs_close (fd) != 0)
	    return -1;
	  errno = read_errno;
	  return read_bytes;
	}

      if (errno != ELOOP)
	return -1;

      /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
	 The former must have been removed and replaced by the latter.
	 Try again.  */
Paul Eggert's avatar
Paul Eggert committed
487
      maybe_quit ();
488
    }
489 490

  return nbytes;
491 492
}

Richard M. Stallman's avatar
Richard M. Stallman committed
493
/* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
494 495 496
   -1 if another process owns it (and set OWNER (if non-null) to info),
   -2 if the current process owns it,
   or an errno value if something is wrong with the locking mechanism.  */
497

Richard M. Stallman's avatar
Richard M. Stallman committed
498
static int
499
current_lock_owner (lock_info_type *owner, char *lfname)
Jim Blandy's avatar
Jim Blandy committed
500
{
501
  int ret;
502
  lock_info_type local_owner;
503 504 505
  ptrdiff_t lfinfolen;
  intmax_t pid, boot_time;
  char *at, *dot, *lfinfo_end;
506

Richard M. Stallman's avatar
Richard M. Stallman committed
507
  /* Even if the caller doesn't want the owner info, we still have to
508
     read it to determine return value.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
509
  if (!owner)
510
    owner = &local_owner;
511

512 513 514
  /* If nonexistent lock file, all is well; otherwise, got strange error. */
  lfinfolen = read_lock_data (lfname, owner->user);
  if (lfinfolen < 0)
Paul Eggert's avatar
Paul Eggert committed
515
    return errno == ENOENT || errno == ENOTDIR ? 0 : errno;
516
  if (MAX_LFINFO < lfinfolen)
517
    return ENAMETOOLONG;
518 519
  owner->user[lfinfolen] = 0;

520
  /* Parse USER@HOST.PID:BOOT_TIME.  If can't parse, return EINVAL.  */
521
  /* The USER is everything before the last @.  */
522 523
  owner->at = at = memrchr (owner->user, '@', lfinfolen);
  if (!at)
524
    return EINVAL;
525 526
  owner->dot = dot = strrchr (at, '.');
  if (!dot)
527
    return EINVAL;
528

529
  /* The PID is everything from the last '.' to the ':' or equivalent.  */
530
  if (! c_isdigit (dot[1]))
531
    return EINVAL;
532
  errno = 0;
533 534 535
  pid = strtoimax (dot + 1, &owner->colon, 10);
  if (errno == ERANGE)
    pid = -1;
536

537 538
  /* After the ':' or equivalent, if there is one, comes the boot time.  */
  char *boot = owner->colon + 1;
539
  switch (owner->colon[0])
540
    {
541 542 543 544 545
    case 0:
      boot_time = 0;
      lfinfo_end = owner->colon;
      break;

546
    case '\357':
547 548 549 550
      /* Treat "\357\200\242" (U+F022 in UTF-8) as if it were ":" (Bug#24656).
	 This works around a bug in the Linux CIFS kernel client, which can
	 mistakenly transliterate ':' to U+F022 in symlink contents.
	 See <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>.  */
551
      if (! (boot[0] == '\200' && boot[1] == '\242'))
552
	return EINVAL;
553
      boot += 2;
554
      FALLTHROUGH;
555
    case ':':
556
      if (! c_isdigit (boot[0]))
557
	return EINVAL;
558
      boot_time = strtoimax (boot, &lfinfo_end, 10);
559 560 561
      break;

    default:
562
      return EINVAL;
563
    }
564
  if (lfinfo_end != owner->user + lfinfolen)
565
    return EINVAL;
566

Richard M. Stallman's avatar
Richard M. Stallman committed
567
  /* On current host?  */
568 569 570 571
  Lisp_Object system_name = Fsystem_name ();
  if (STRINGP (system_name)
      && dot - (at + 1) == SBYTES (system_name)
      && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0)
Jim Blandy's avatar
Jim Blandy committed
572
    {
573
      if (pid == getpid ())
574
        ret = -2; /* We own it.  */
575 576 577 578 579
      else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t)
               && (kill (pid, 0) >= 0 || errno == EPERM)
	       && (boot_time == 0
		   || (boot_time <= TYPE_MAXIMUM (time_t)
		       && within_one_second (boot_time, get_boot_time ()))))
580
        ret = -1; /* An existing process on this machine owns it.  */
581
      /* The owner process is dead or has a strange pid, so try to
Richard M. Stallman's avatar
Richard M. Stallman committed
582
         zap the lockfile.  */
583
      else
584
        return unlink (lfname) < 0 ? errno : 0;
Jim Blandy's avatar
Jim Blandy committed
585
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
586 587 588
  else
    { /* If we wanted to support the check for stale locks on remote machines,
         here's where we'd do it.  */
589
      ret = -1;
Richard M. Stallman's avatar
Richard M. Stallman committed
590
    }
591

Richard M. Stallman's avatar
Richard M. Stallman committed
592
  return ret;
Jim Blandy's avatar
Jim Blandy committed
593 594
}

Richard M. Stallman's avatar
Richard M. Stallman committed
595 596 597

/* Lock the lock named LFNAME if possible.
   Return 0 in that case.
598
   Return negative if some other process owns the lock, and info about
Richard M. Stallman's avatar
Richard M. Stallman committed
599
     that process in CLASHER.
600
   Return positive errno value if cannot lock for any other reason.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
601

Richard M. Stallman's avatar
Richard M. Stallman committed
602
static int
603
lock_if_free (lock_info_type *clasher, char *lfname)
Richard M. Stallman's avatar
Richard M. Stallman committed
604
{
605 606
  int err;
  while ((err = lock_file_1 (lfname, 0)) == EEXIST)
Richard M. Stallman's avatar
Richard M. Stallman committed
607
    {
608 609
      err = current_lock_owner (clasher, lfname);
      if (err != 0)
610
	{
611 612 613
	  if (err < 0)
	    return -2 - err; /* We locked it, or someone else has it.  */
	  break; /* current_lock_owner returned strange error.  */
614
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
615

616
      /* We deleted a stale lock; try again to lock the file.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
617
    }
618

619
  return err;
Richard M. Stallman's avatar
Richard M. Stallman committed
620 621
}

622 623 624
static Lisp_Object
make_lock_file_name (Lisp_Object fn)
{
625 626 627 628
  Lisp_Object func = intern ("make-lock-file-name");
  if (NILP (Fboundp (func)))
    return Qnil;
  return call1 (func, Fexpand_file_name (fn, Qnil));
629 630
}

Richard M. Stallman's avatar
Richard M. Stallman committed
631
/* lock_file locks file FN,
Richard M. Stallman's avatar
Richard M. Stallman committed
632 633 634
   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
635
   Do not (normally) call this for a buffer already modified,
Richard M. Stallman's avatar
Richard M. Stallman committed
636 637 638
   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
639
   When this returns, either the lock is locked for us,
640
   or lock creation failed,
Richard M. Stallman's avatar
Richard M. Stallman committed
641 642
   or the user has said to go ahead without locking.

Richard M. Stallman's avatar
Richard M. Stallman committed
643
   If the file is locked by someone else, this calls
Richard M. Stallman's avatar
Richard M. Stallman committed
644
   ask-user-about-lock (a Lisp function) with two arguments,
Richard M. Stallman's avatar
Richard M. Stallman committed
645
   the file name and info about the user who did the locking.
Richard M. Stallman's avatar
Richard M. Stallman committed
646 647 648 649
   This function can signal an error, or return t meaning
   take away the lock, or return nil meaning ignore the lock.  */

void
650
lock_file (Lisp_Object fn)
Richard M. Stallman's avatar
Richard M. Stallman committed
651
{
Richard M. Stallman's avatar
Richard M. Stallman committed
652
  lock_info_type lock_info;
Richard M. Stallman's avatar
Richard M. Stallman committed
653

654 655 656
  /* Don't do locking while dumping Emacs.
     Uncompressing wtmp files uses call-process, which does not work
     in an uninitialized Emacs.  */
Daniel Colascione's avatar
Daniel Colascione committed
657
  if (will_dump_p ())
658 659
    return;

660 661 662 663 664 665 666 667
  Lisp_Object handler;
  handler = Ffind_file_name_handler (fn, Qlock_file);
  if (!NILP (handler))
    {
      call2 (handler, Qlock_file, fn);
      return;
    }

668
  Lisp_Object lock_filename = make_lock_file_name (fn);
669 670
  if (NILP (lock_filename))
    return;
671
  char *lfname = SSDATA (ENCODE_FILE (lock_filename));
672

Jim Blandy's avatar
Jim Blandy committed
673 674
  /* See if this file is visited and has changed on disk since it was
     visited.  */
675
  Lisp_Object subject_buf = get_truename_buffer (fn);
676 677
  if (!NILP (subject_buf)
      && NILP (Fverify_visited_file_modtime (subject_buf))
678 679
      && !NILP (Ffile_exists_p (lock_filename))
      && !(create_lockfiles && current_lock_owner (NULL, lfname) == -2))
680
    call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
681

682
  /* Don't do locking if the user has opted out.  */
683
  if (create_lockfiles)
Richard M. Stallman's avatar
Richard M. Stallman committed
684
    {
685 686 687
      /* Try to lock the lock.  FIXME: This ignores errors when
	 lock_if_free returns a positive errno value.  */
      if (lock_if_free (&lock_info, lfname) < 0)
688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
	{
	  /* Someone else has the lock.  Consider breaking it.  */
	  Lisp_Object attack;
	  char *dot = lock_info.dot;
	  ptrdiff_t pidlen = lock_info.colon - (dot + 1);
	  static char const replacement[] = " (pid ";
	  int replacementlen = sizeof replacement - 1;
	  memmove (dot + replacementlen, dot + 1, pidlen);
	  strcpy (dot + replacementlen + pidlen, ")");
	  memcpy (dot, replacement, replacementlen);
	  attack = call2 (intern ("ask-user-about-lock"), fn,
			  build_string (lock_info.user));
	  /* Take the lock if the user said so.  */
	  if (!NILP (attack))
	    lock_file_1 (lfname, 1);
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
704 705 706
    }
}

707 708
static Lisp_Object
unlock_file_body (Lisp_Object fn)
Richard M. Stallman's avatar
Richard M. Stallman committed
709
{
710
  char *lfname;
Richard M. Stallman's avatar
Richard M. Stallman committed
711

712 713 714 715 716 717 718 719 720 721
  /* If the file name has special constructs in it,
     call the corresponding file name handler.  */
  Lisp_Object handler;
  handler = Ffind_file_name_handler (fn, Qunlock_file);
  if (!NILP (handler))
    {
      call2 (handler, Qunlock_file, fn);
      return Qnil;
    }

722
  Lisp_Object lock_filename = make_lock_file_name (fn);
723 724
  if (NILP (lock_filename))
    return Qnil;
725
  lfname = SSDATA (ENCODE_FILE (lock_filename));
Richard M. Stallman's avatar
Richard M. Stallman committed
726

727 728 729 730
  int err = current_lock_owner (0, lfname);
  if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
    err = errno;
  if (0 < err)
731
    report_file_errno ("Unlocking file", fn, err);
732

733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749
  return Qnil;
}

static Lisp_Object
unlock_file_handle_error (Lisp_Object err)
{
  call1 (intern ("userlock--handle-unlock-error"), err);
  return Qnil;
}

void
unlock_file (Lisp_Object fn)
{
  internal_condition_case_1 (unlock_file_body,
			     fn,
			     list1(Qfile_error),
			     unlock_file_handle_error);
Richard M. Stallman's avatar
Richard M. Stallman committed
750 751
}

Eli Zaretskii's avatar
Eli Zaretskii committed
752 753 754 755 756 757 758 759 760 761 762 763 764
#else  /* MSDOS */
void
lock_file (Lisp_Object fn)
{
}

void
unlock_file (Lisp_Object fn)
{
}

#endif	/* MSDOS */

Richard M. Stallman's avatar
Richard M. Stallman committed
765
void
766
unlock_all_files (void)
Richard M. Stallman's avatar
Richard M. Stallman committed
767
{
768
  register Lisp_Object tail, buf;
Richard M. Stallman's avatar
Richard M. Stallman committed
769 770
  register struct buffer *b;

771
  FOR_EACH_LIVE_BUFFER (tail, buf)
Richard M. Stallman's avatar
Richard M. Stallman committed
772
    {
773 774 775 776
      b = XBUFFER (buf);
      if (STRINGP (BVAR (b, file_truename))
	  && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
	unlock_file (BVAR (b, file_truename));
Richard M. Stallman's avatar
Richard M. Stallman committed
777 778 779
    }
}

780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800
DEFUN ("lock-file", Flock_file, Slock_file,
       0, 1, 0,
       doc: /* Lock FILE.
If the option `create-lockfiles' is nil, this does nothing.  */)
  (Lisp_Object file)
{
  CHECK_STRING (file);
  lock_file (file);
  return Qnil;
}

DEFUN ("unlock-file", Funlock_file, Sunlock_file,
       0, 1, 0,
       doc: /* Unlock FILE.  */)
  (Lisp_Object file)
{
  CHECK_STRING (file);
  unlock_file (file);
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
801
DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
802 803 804
       0, 1, 0,
       doc: /* Lock FILE, if current buffer is modified.
FILE defaults to current buffer's visited file,
805 806 807
or else nothing is done if current buffer isn't visiting a file.

If the option `create-lockfiles' is nil, this does nothing.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
808
  (Lisp_Object file)
Richard M. Stallman's avatar
Richard M. Stallman committed
809
{
810
  if (NILP (file))
Tom Tromey's avatar
Tom Tromey committed
811
    file = BVAR (current_buffer, file_truename);
Richard M. Stallman's avatar
Richard M. Stallman committed
812
  else
813
    CHECK_STRING (file);
814
  if (SAVE_MODIFF < MODIFF
815 816
      && !NILP (file))
    lock_file (file);
817
  return Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
818 819
}

Paul Eggert's avatar
Paul Eggert committed
820
DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
821
       0, 0, 0,
822 823
       doc: /* Unlock the file visited in the current buffer.
If the buffer is not modified, this does nothing because the file
824 825 826 827
should not be locked in that case.  It also does nothing if the
current buffer is not visiting a file, or is not locked.  Handles file
system errors by calling `display-warning' and continuing as if the
error did not occur.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
828
  (void)
Richard M. Stallman's avatar
Richard M. Stallman committed
829
{
830
  if (SAVE_MODIFF < MODIFF
Tom Tromey's avatar
Tom Tromey committed
831 832
      && STRINGP (BVAR (current_buffer, file_truename)))
    unlock_file (BVAR (current_buffer, file_truename));
Richard M. Stallman's avatar
Richard M. Stallman committed
833 834 835 836 837
  return Qnil;
}

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

838
void
839
unlock_buffer (struct buffer *buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
840
{
841
  if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
Tom Tromey's avatar
Tom Tromey committed
842 843
      && STRINGP (BVAR (buffer, file_truename)))
    unlock_file (BVAR (buffer, file_truename));
Richard M. Stallman's avatar
Richard M. Stallman committed
844 845
}

846
DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
847 848 849
       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
850
  (Lisp_Object filename)
Richard M. Stallman's avatar
Richard M. Stallman committed
851
{
Eli Zaretskii's avatar
Eli Zaretskii committed
852 853 854
#ifdef MSDOS
  return Qnil;
#else
Richard M. Stallman's avatar
Richard M. Stallman committed
855
  Lisp_Object ret;
Richard M. Stallman's avatar
Richard M. Stallman committed
856
  int owner;
Richard M. Stallman's avatar
Richard M. Stallman committed
857
  lock_info_type locker;
Richard M. Stallman's avatar
Richard M. Stallman committed
858

859 860 861 862 863 864 865 866 867
  /* If the file name has special constructs in it,
     call the corresponding file name handler.  */
  Lisp_Object handler;
  handler = Ffind_file_name_handler (filename, Qfile_locked_p);
  if (!NILP (handler))
    {
      return call2 (handler, Qfile_locked_p, filename);
    }

868
  Lisp_Object lock_filename = make_lock_file_name (filename);