filelock.c 18.7 KB
Newer Older
1 2
/* Lock files for editing.
   Copyright (C) 1985, 86, 87, 93, 94, 96, 98, 1999 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
3 4 5 6 7

This file is part of GNU Emacs.

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

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
along with GNU Emacs; see the file COPYING.  If not, write to
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
20 21 22 23


#include <sys/types.h>
#include <sys/stat.h>
Andreas Schwab's avatar
Andreas Schwab committed
24
#include <signal.h>
25
#include <config.h>
Dave Love's avatar
Dave Love committed
26 27 28
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
Jim Blandy's avatar
Jim Blandy committed
29 30

#ifdef VMS
Jim Blandy's avatar
Jim Blandy committed
31
#include "vms-pwd.h"
Jim Blandy's avatar
Jim Blandy committed
32
#else
Richard M. Stallman's avatar
Richard M. Stallman committed
33
#include <pwd.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
34
#endif /* not VMS */
Jim Blandy's avatar
Jim Blandy committed
35

Richard M. Stallman's avatar
Richard M. Stallman committed
36 37 38
#include <sys/file.h>
#ifdef USG
#include <fcntl.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
39
#include <string.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
40 41
#endif /* USG */

Andreas Schwab's avatar
Andreas Schwab committed
42 43 44 45
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

46 47 48 49 50 51
#ifdef __FreeBSD__
#include <sys/time.h>
#include <sys/types.h>
#include <sys/sysctl.h>
#endif /* __FreeBSD__ */

Richard M. Stallman's avatar
Richard M. Stallman committed
52 53
#include "lisp.h"
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
54 55
#include "charset.h"
#include "coding.h"
56
#include "systime.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
57

58
#include <time.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
59 60
#include <errno.h>
#ifndef errno
Richard M. Stallman's avatar
Richard M. Stallman committed
61
extern int errno;
62 63
#endif

Richard M. Stallman's avatar
Richard M. Stallman committed
64
#ifdef CLASH_DETECTION
65 66

#include <utmp.h>
67

Paul Eggert's avatar
Paul Eggert committed
68 69 70 71 72 73
/* 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

74 75 76
#ifndef WTMP_FILE
#define WTMP_FILE "/var/log/wtmp"
#endif
Richard M. Stallman's avatar
Richard M. Stallman committed
77
  
Richard M. Stallman's avatar
Richard M. Stallman committed
78 79 80 81 82 83 84 85 86 87 88 89 90 91
/* 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.
   
   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
92
   environment, it seems such stale locks arise fairly infrequently, and
Richard M. Stallman's avatar
Richard M. Stallman committed
93 94 95 96 97 98
   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
99
   files to be useful on old systems lacking symlinks, nowadays
Richard M. Stallman's avatar
Richard M. Stallman committed
100 101 102 103 104 105 106 107 108 109 110 111
   virtually all such systems are probably single-user anyway, so it
   didn't seem worth the complication.
   
   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.
   
   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.
   
   --karl@cs.umb.edu/karl@hq.ileaf.com.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
112

113 114 115 116

/* Return the time of the last system boot.  */

static time_t boot_time;
117
static int boot_time_initialized;
118

119 120
extern Lisp_Object Vshell_file_name;

121 122 123
static time_t
get_boot_time ()
{
124
  int counter;
125

126
  if (boot_time_initialized)
127
    return boot_time;
128
  boot_time_initialized = 1;
129

130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
#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) */
147

Paul Eggert's avatar
Paul Eggert committed
148 149 150 151 152 153 154 155 156 157
  if (BOOT_TIME_FILE)
    {
      struct stat st;
      if (stat (BOOT_TIME_FILE, &st) == 0)
	{
	  boot_time = st.st_mtime;
	  return boot_time;
	}
    }

158
#if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
#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;

175
  /* Try to get boot time from the current wtmp file.  */
176
  get_boot_time_1 (WTMP_FILE, 1);
177 178

  /* If we did not find a boot time in wtmp, look at wtmp, and so on.  */
179
  for (counter = 0; counter < 20 && ! boot_time; counter++)
180 181 182 183 184 185 186
    {
      char cmd_string[100];
      Lisp_Object tempname, filename;
      int delete_flag = 0;

      filename = Qnil;

187
      sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
188
      tempname = build_string (cmd_string);
189
      if (! NILP (Ffile_exists_p (tempname)))
190 191 192
	filename = tempname;
      else
	{
193
	  sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
194 195 196 197 198 199 200 201 202 203
	  tempname = build_string (cmd_string);
	  if (! NILP (Ffile_exists_p (tempname)))
	    {
	      Lisp_Object args[6];
	      tempname = Fmake_temp_name (build_string ("wtmp"));
	      args[0] = Vshell_file_name;
	      args[1] = Qnil;
	      args[2] = Qnil;
	      args[3] = Qnil;
	      args[4] = build_string ("-c");
204 205
	      sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
		       WTMP_FILE, counter, XSTRING (tempname)->data);
206 207 208 209 210 211 212 213 214
	      args[5] = build_string (cmd_string);
	      Fcall_process (6, args);
	      filename = tempname;
	      delete_flag = 1;
	    }
	}

      if (! NILP (filename))
	{
215
	  get_boot_time_1 (XSTRING (filename)->data, 1);
216 217 218 219 220 221 222 223 224 225 226
	  if (delete_flag)
	    unlink (XSTRING (filename)->data);
	}
    }

  return boot_time;
#else
  return 0;
#endif
}

227
#ifdef BOOT_TIME
228 229 230
/* Try to get the boot time from wtmp file FILENAME.
   This succeeds if that file contains a reboot record.

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

get_boot_time_1 (filename, newest)
239
     char *filename;
240
     int newest;
241 242
{
  struct utmp ut, *utp;
243 244
  int desc;

245 246 247 248 249 250 251 252 253 254 255 256
  if (filename)
    {
      /* On some versions of IRIX, opening a nonexistent file name
	 is likely to crash in the utmp routines.  */
      desc = open (filename, O_RDONLY);
      if (desc < 0)
	return;

      close (desc);

      utmpname (filename);
    }
257

258
  setutent ();
259

260 261 262 263 264 265 266 267 268
  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)
269 270 271 272 273
	{
	  boot_time = utp->ut_time;
	  if (! newest)
	    break;
	}
274 275 276 277 278 279
      /* Advance on element in the file
	 so that getutid won't repeat the same one.  */
      utp = getutent ();
      if (! utp)
	break;
    }
280 281
  endutent ();
}
282
#endif /* BOOT_TIME */
Richard M. Stallman's avatar
Richard M. Stallman committed
283 284

/* Here is the structure that stores information about a lock.  */
Jim Blandy's avatar
Jim Blandy committed
285

Richard M. Stallman's avatar
Richard M. Stallman committed
286 287 288 289
typedef struct
{
  char *user;
  char *host;
290
  unsigned long pid;
291
  time_t boot_time;
Richard M. Stallman's avatar
Richard M. Stallman committed
292
} lock_info_type;
Jim Blandy's avatar
Jim Blandy committed
293

294 295 296
/* When we read the info back, we might need this much more,
   enough for decimal representation plus null.  */
#define LOCK_PID_MAX (4 * sizeof (unsigned long))
Jim Blandy's avatar
Jim Blandy committed
297

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


Richard M. Stallman's avatar
Richard M. Stallman committed
302 303
/* Write the name of the lock file for FN into LFNAME.  Length will be
   that of FN plus two more for the leading `.#' plus one for the null.  */
304
#define MAKE_LOCK_NAME(lock, file) \
305
  (lock = (char *) alloca (STRING_BYTES (XSTRING (file)) + 2 + 1), \
Richard M. Stallman's avatar
Richard M. Stallman committed
306
   fill_in_lock_file_name (lock, (file)))
307

Richard M. Stallman's avatar
Richard M. Stallman committed
308 309
static void
fill_in_lock_file_name (lockfile, fn)
310 311 312
     register char *lockfile;
     register Lisp_Object fn;
{
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314 315 316 317 318 319 320 321
  register char *p;

  strcpy (lockfile, XSTRING (fn)->data);

  /* 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.  */
  for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
    p[2] = *p;
322
  
Richard M. Stallman's avatar
Richard M. Stallman committed
323 324 325 326
  /* Insert the `.#'.  */
  p[1] = '.';
  p[2] = '#';
}
327

Richard M. Stallman's avatar
Richard M. Stallman committed
328 329 330
/* Lock the lock file named LFNAME.
   If FORCE is nonzero, we do so even if it is already locked.
   Return 1 if successful, 0 if not.  */
331

Richard M. Stallman's avatar
Richard M. Stallman committed
332 333 334 335 336 337
static int
lock_file_1 (lfname, force)
     char *lfname; 
     int force;
{
  register int err;
338
  time_t boot_time;
339 340 341 342 343
  char *user_name;
  char *host_name;
  char *lock_info_str;

  if (STRINGP (Fuser_login_name (Qnil)))
344
    user_name = (char *)XSTRING (Fuser_login_name (Qnil))->data;
345 346 347
  else
    user_name = "";
  if (STRINGP (Fsystem_name ()))
348
    host_name = (char *)XSTRING (Fsystem_name ())->data;
349 350
  else
    host_name = "";
351
  lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
352
				  + LOCK_PID_MAX + 5);
Richard M. Stallman's avatar
Richard M. Stallman committed
353

354 355 356 357 358 359 360
  boot_time = get_boot_time ();
  if (boot_time)
    sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name,
	     (unsigned long) getpid (), (unsigned long) boot_time);
  else
    sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
	     (unsigned long) getpid ());    
Richard M. Stallman's avatar
Richard M. Stallman committed
361 362 363

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

Richard M. Stallman's avatar
Richard M. Stallman committed
369 370
  return err == 0;
}
371

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

374 375 376 377 378 379
int
within_one_second (a, b)
     time_t a, b;
{
  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 387 388 389
static int
current_lock_owner (owner, lfname)
     lock_info_type *owner;
     char *lfname;
Jim Blandy's avatar
Jim Blandy committed
390
{
Richard M. Stallman's avatar
Richard M. Stallman committed
391 392 393 394 395
#ifndef index
  extern char *rindex (), *index ();
#endif
  int o, p, len, ret;
  int local_owner = 0;
396
  char *at, *dot, *colon;
Richard M. Stallman's avatar
Richard M. Stallman committed
397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
  char *lfinfo = 0;
  int bufsize = 50;
  /* Read arbitrarily-long contents of symlink.  Similar code in
     file-symlink-p in fileio.c.  */
  do
    {
      bufsize *= 2;
      lfinfo = (char *) xrealloc (lfinfo, bufsize);
      len = readlink (lfname, lfinfo, bufsize);
    }
  while (len >= bufsize);
  
  /* If nonexistent lock file, all is well; otherwise, got strange error. */
  if (len == -1)
    {
      xfree (lfinfo);
      return errno == ENOENT ? 0 : -1;
    }
Jim Blandy's avatar
Jim Blandy committed
415

Richard M. Stallman's avatar
Richard M. Stallman committed
416 417 418 419 420 421 422
  /* Link info exists, so `len' is its length.  Null terminate.  */
  lfinfo[len] = 0;
  
  /* Even if the caller doesn't want the owner info, we still have to
     read it to determine return value, so allocate it.  */
  if (!owner)
    {
423
      owner = (lock_info_type *) alloca (sizeof (lock_info_type));
Richard M. Stallman's avatar
Richard M. Stallman committed
424 425 426
      local_owner = 1;
    }
  
427
  /* Parse USER@HOST.PID:BOOT_TIME.  If can't parse, return -1.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
428 429 430
  /* The USER is everything before the first @.  */
  at = index (lfinfo, '@');
  dot = rindex (lfinfo, '.');
431 432 433 434 435
  if (!at || !dot)
    {
      xfree (lfinfo);
      return -1;
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
436 437 438 439 440
  len = at - lfinfo;
  owner->user = (char *) xmalloc (len + 1);
  strncpy (owner->user, lfinfo, len);
  owner->user[len] = 0;
  
441
  /* The PID is everything from the last `.' to the `:'.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
442
  owner->pid = atoi (dot + 1);
443 444 445 446 447 448 449 450
  colon = dot;
  while (*colon && *colon != ':')
    colon++;
  /* After the `:', if there is one, comes the boot time.  */
  if (*colon == ':')
    owner->boot_time = atoi (colon + 1);
  else
    owner->boot_time = 0;
Jim Blandy's avatar
Jim Blandy committed
451

Richard M. Stallman's avatar
Richard M. Stallman committed
452 453 454 455 456
  /* The host is everything in between.  */
  len = dot - at - 1;
  owner->host = (char *) xmalloc (len + 1);
  strncpy (owner->host, at + 1, len);
  owner->host[len] = 0;
Jim Blandy's avatar
Jim Blandy committed
457

Richard M. Stallman's avatar
Richard M. Stallman committed
458 459 460 461
  /* We're done looking at the link info.  */
  xfree (lfinfo);
  
  /* On current host?  */
462 463
  if (STRINGP (Fsystem_name ())
      && strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
Jim Blandy's avatar
Jim Blandy committed
464
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
465 466
      if (owner->pid == getpid ())
        ret = 2; /* We own it.  */
467
      else if (owner->pid > 0
468 469
               && (kill (owner->pid, 0) >= 0 || errno == EPERM)
	       && (owner->boot_time == 0
470
		   || within_one_second (owner->boot_time, get_boot_time ())))
Richard M. Stallman's avatar
Richard M. Stallman committed
471 472 473
        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.  */
474
      else if (unlink (lfname) < 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
475
        ret = -1;
476 477
      else
	ret = 0;
Jim Blandy's avatar
Jim Blandy committed
478
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
479 480 481 482 483 484 485 486 487 488 489 490
  else
    { /* If we wanted to support the check for stale locks on remote machines,
         here's where we'd do it.  */
      ret = 1;
    }
  
  /* Avoid garbage.  */
  if (local_owner || ret <= 0)
    {
      FREE_LOCK_INFO (*owner);
    }
  return ret;
Jim Blandy's avatar
Jim Blandy committed
491 492
}

Richard M. Stallman's avatar
Richard M. Stallman committed
493 494 495 496 497 498

/* 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
499

Richard M. Stallman's avatar
Richard M. Stallman committed
500 501 502 503 504
static int
lock_if_free (clasher, lfname)
     lock_info_type *clasher;
     register char *lfname; 
{
505
  while (lock_file_1 (lfname, 0) == 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
506 507
    {
      int locker;
508

Richard M. Stallman's avatar
Richard M. Stallman committed
509 510 511 512 513 514 515 516 517 518 519
      if (errno != EEXIST)
	return -1;
      
      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.  */
520
      else if (locker == -1)
Richard M. Stallman's avatar
Richard M. Stallman committed
521
	return -1;   /* current_lock_owner returned strange error.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
522

523
      /* We deleted a stale lock; try again to lock the file.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
524 525
    }
  return 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
526 527
}

Richard M. Stallman's avatar
Richard M. Stallman committed
528
/* lock_file locks file FN,
Richard M. Stallman's avatar
Richard M. Stallman committed
529 530 531
   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
532
   Do not (normally) call this for a buffer already modified,
Richard M. Stallman's avatar
Richard M. Stallman committed
533 534 535
   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
536
   When this returns, either the lock is locked for us,
Richard M. Stallman's avatar
Richard M. Stallman committed
537 538
   or the user has said to go ahead without locking.

Richard M. Stallman's avatar
Richard M. Stallman committed
539
   If the file is locked by someone else, this calls
Richard M. Stallman's avatar
Richard M. Stallman committed
540
   ask-user-about-lock (a Lisp function) with two arguments,
Richard M. Stallman's avatar
Richard M. Stallman committed
541
   the file name and info about the user who did the locking.
Richard M. Stallman's avatar
Richard M. Stallman committed
542 543 544 545 546
   This function can signal an error, or return t meaning
   take away the lock, or return nil meaning ignore the lock.  */

void
lock_file (fn)
Richard M. Stallman's avatar
Richard M. Stallman committed
547
     Lisp_Object fn;
Richard M. Stallman's avatar
Richard M. Stallman committed
548
{
Richard M. Stallman's avatar
Richard M. Stallman committed
549
  register Lisp_Object attack, orig_fn, encoded_fn;
Richard M. Stallman's avatar
Richard M. Stallman committed
550 551
  register char *lfname, *locker;
  lock_info_type lock_info;
Richard M. Stallman's avatar
Richard M. Stallman committed
552

553 554 555 556 557 558
  /* 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;

559
  orig_fn = fn;
560
  fn = Fexpand_file_name (fn, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
561
  encoded_fn = ENCODE_FILE (fn);
562

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

Jim Blandy's avatar
Jim Blandy committed
566 567
  /* See if this file is visited and has changed on disk since it was
     visited.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
568
  {
569
    register Lisp_Object subject_buf;
Richard M. Stallman's avatar
Richard M. Stallman committed
570
    struct gcpro gcpro1;
Richard M. Stallman's avatar
Richard M. Stallman committed
571

572
    subject_buf = get_truename_buffer (orig_fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
573 574
    GCPRO1 (fn);

Jim Blandy's avatar
Jim Blandy committed
575 576 577
    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
578
      call1 (intern ("ask-user-about-supersession-threat"), fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
579 580

    UNGCPRO;
Richard M. Stallman's avatar
Richard M. Stallman committed
581 582 583
  }

  /* Try to lock the lock. */
Richard M. Stallman's avatar
Richard M. Stallman committed
584 585
  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
586 587 588
    return;

  /* Else consider breaking the lock */
589 590
  locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
			    + LOCK_PID_MAX + 9);
591
  sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
Richard M. Stallman's avatar
Richard M. Stallman committed
592 593 594 595
           lock_info.pid);
  FREE_LOCK_INFO (lock_info);
  
  attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
Jim Blandy's avatar
Jim Blandy committed
596
  if (!NILP (attack))
Richard M. Stallman's avatar
Richard M. Stallman committed
597 598
    /* User says take the lock */
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
599
      lock_file_1 (lfname, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
600 601 602 603 604 605 606 607 608 609 610
      return;
    }
  /* User says ignore the lock */
}

void
unlock_file (fn)
     register Lisp_Object fn;
{
  register char *lfname;

611
  fn = Fexpand_file_name (fn, Qnil);
612
  fn = ENCODE_FILE (fn);
613

614
  MAKE_LOCK_NAME (lfname, fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
615

Richard M. Stallman's avatar
Richard M. Stallman committed
616
  if (current_lock_owner (0, lfname) == 2)
Richard M. Stallman's avatar
Richard M. Stallman committed
617 618 619 620 621 622 623 624 625
    unlink (lfname);
}

void
unlock_all_files ()
{
  register Lisp_Object tail;
  register struct buffer *b;

626
  for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
Richard M. Stallman's avatar
Richard M. Stallman committed
627 628
    {
      b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
629
      if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
630 631 632 633 634 635 636 637
	{
	  register char *lfname;

	  MAKE_LOCK_NAME (lfname, b->file_truename);

	  if (current_lock_owner (0, lfname) == 2)
	    unlink (lfname);
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
638 639 640 641 642 643 644 645
    }
}

DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
  0, 1, 0,
  "Lock FILE, if current buffer is modified.\n\
FILE defaults to current buffer's visited file,\n\
or else nothing is done if current buffer isn't visiting a file.")
646 647
  (file)
     Lisp_Object file;
Richard M. Stallman's avatar
Richard M. Stallman committed
648
{
649 650
  if (NILP (file))
    file = current_buffer->file_truename;
Richard M. Stallman's avatar
Richard M. Stallman committed
651
  else
652
    CHECK_STRING (file, 0);
653
  if (SAVE_MODIFF < MODIFF
654 655
      && !NILP (file))
    lock_file (file);
Richard M. Stallman's avatar
Richard M. Stallman committed
656 657 658 659 660 661 662 663 664
  return Qnil;    
}

DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
  0, 0, 0,
 "Unlock the file visited in the current buffer,\n\
if it should normally be locked.")
  ()
{
665
  if (SAVE_MODIFF < MODIFF
666 667
      && STRINGP (current_buffer->file_truename))
    unlock_file (current_buffer->file_truename);
Richard M. Stallman's avatar
Richard M. Stallman committed
668 669 670 671 672
  return Qnil;
}

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

673
void
Richard M. Stallman's avatar
Richard M. Stallman committed
674 675 676
unlock_buffer (buffer)
     struct buffer *buffer;
{
677
  if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
678 679
      && STRINGP (buffer->file_truename))
    unlock_file (buffer->file_truename);
Richard M. Stallman's avatar
Richard M. Stallman committed
680 681 682 683 684
}

DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
  "Return nil if the FILENAME is not locked,\n\
t if it is locked by you, else a string of the name of the locker.")
685 686
  (filename)
  Lisp_Object filename;
Richard M. Stallman's avatar
Richard M. Stallman committed
687
{
Richard M. Stallman's avatar
Richard M. Stallman committed
688
  Lisp_Object ret;
Richard M. Stallman's avatar
Richard M. Stallman committed
689 690
  register char *lfname;
  int owner;
Richard M. Stallman's avatar
Richard M. Stallman committed
691
  lock_info_type locker;
Richard M. Stallman's avatar
Richard M. Stallman committed
692

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

695
  MAKE_LOCK_NAME (lfname, filename);
Richard M. Stallman's avatar
Richard M. Stallman committed
696

Richard M. Stallman's avatar
Richard M. Stallman committed
697
  owner = current_lock_owner (&locker, lfname);
Richard M. Stallman's avatar
Richard M. Stallman committed
698
  if (owner <= 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
699 700 701 702 703 704 705 706 707 708
    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
709
}
Jim Blandy's avatar
Jim Blandy committed
710 711 712

/* Initialization functions.  */

Karl Heuer's avatar
Karl Heuer committed
713 714 715 716
void
init_filelock ()
{
  boot_time = 0;
717
  boot_time_initialized = 0;
Karl Heuer's avatar
Karl Heuer committed
718 719
}

Andreas Schwab's avatar
Andreas Schwab committed
720
void
Richard M. Stallman's avatar
Richard M. Stallman committed
721 722 723 724 725 726 727 728
syms_of_filelock ()
{
  defsubr (&Sunlock_buffer);
  defsubr (&Slock_buffer);
  defsubr (&Sfile_locked_p);
}

#endif /* CLASH_DETECTION */