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

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
7
the Free Software Foundation; either version 2, or (at your option)
Richard M. Stallman's avatar
Richard M. Stallman committed
8 9 10 11 12 13 14 15 16
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
17 18
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
19 20 21 22


#include <sys/types.h>
#include <sys/stat.h>
Andreas Schwab's avatar
Andreas Schwab committed
23
#include <signal.h>
24
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
25 26

#ifdef VMS
Jim Blandy's avatar
Jim Blandy committed
27
#include "vms-pwd.h"
Jim Blandy's avatar
Jim Blandy committed
28
#else
Richard M. Stallman's avatar
Richard M. Stallman committed
29
#include <pwd.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
30
#endif /* not VMS */
Jim Blandy's avatar
Jim Blandy committed
31

Richard M. Stallman's avatar
Richard M. Stallman committed
32 33 34
#include <sys/file.h>
#ifdef USG
#include <fcntl.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
35
#include <string.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
36 37
#endif /* USG */

Andreas Schwab's avatar
Andreas Schwab committed
38 39 40 41
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

Richard M. Stallman's avatar
Richard M. Stallman committed
42 43
#include "lisp.h"
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
44 45
#include "charset.h"
#include "coding.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
46

47
#include <time.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
48 49
#include <errno.h>
#ifndef errno
Richard M. Stallman's avatar
Richard M. Stallman committed
50
extern int errno;
51 52
#endif

Richard M. Stallman's avatar
Richard M. Stallman committed
53
#ifdef CLASH_DETECTION
54 55

#include <utmp.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
56
  
Richard M. Stallman's avatar
Richard M. Stallman committed
57 58 59 60 61 62 63 64 65 66 67 68 69 70
/* 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
71
   environment, it seems such stale locks arise fairly infrequently, and
Richard M. Stallman's avatar
Richard M. Stallman committed
72 73 74 75 76 77
   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
78
   files to be useful on old systems lacking symlinks, nowadays
Richard M. Stallman's avatar
Richard M. Stallman committed
79 80 81 82 83 84 85 86 87 88 89 90
   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
91

92 93 94 95 96 97 98 99

/* Return the time of the last system boot.  */

static time_t boot_time;

static time_t
get_boot_time ()
{
100
#ifdef BOOT_TIME
101 102 103 104 105 106
  struct utmp ut, *utp;

  if (boot_time)
    return boot_time;

  utmpname ("/var/log/wtmp");
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
  setutent ();
  boot_time = 1;
  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)
	boot_time = utp->ut_time;
      /* Advance on element in the file
	 so that getutid won't repeat the same one.  */
      utp = getutent ();
      if (! utp)
	break;
    }
125 126
  endutent ();

127
  return boot_time;
128 129
#else
  return 0;
130
#endif
131
}
Richard M. Stallman's avatar
Richard M. Stallman committed
132 133

/* Here is the structure that stores information about a lock.  */
Jim Blandy's avatar
Jim Blandy committed
134

Richard M. Stallman's avatar
Richard M. Stallman committed
135 136 137 138
typedef struct
{
  char *user;
  char *host;
139
  unsigned long pid;
140
  time_t boot_time;
Richard M. Stallman's avatar
Richard M. Stallman committed
141
} lock_info_type;
Jim Blandy's avatar
Jim Blandy committed
142

143 144 145
/* 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
146

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


Richard M. Stallman's avatar
Richard M. Stallman committed
151 152
/* 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.  */
153
#define MAKE_LOCK_NAME(lock, file) \
154
  (lock = (char *) alloca (STRING_BYTES (XSTRING (file)) + 2 + 1), \
Richard M. Stallman's avatar
Richard M. Stallman committed
155
   fill_in_lock_file_name (lock, (file)))
156

Richard M. Stallman's avatar
Richard M. Stallman committed
157 158
static void
fill_in_lock_file_name (lockfile, fn)
159 160 161
     register char *lockfile;
     register Lisp_Object fn;
{
Richard M. Stallman's avatar
Richard M. Stallman committed
162 163 164 165 166 167 168 169 170
  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;
171
  
Richard M. Stallman's avatar
Richard M. Stallman committed
172 173 174 175
  /* Insert the `.#'.  */
  p[1] = '.';
  p[2] = '#';
}
176

Richard M. Stallman's avatar
Richard M. Stallman committed
177 178 179
/* 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.  */
180

Richard M. Stallman's avatar
Richard M. Stallman committed
181 182 183 184 185 186
static int
lock_file_1 (lfname, force)
     char *lfname; 
     int force;
{
  register int err;
187
  time_t boot_time;
188 189 190 191 192
  char *user_name;
  char *host_name;
  char *lock_info_str;

  if (STRINGP (Fuser_login_name (Qnil)))
193
    user_name = (char *)XSTRING (Fuser_login_name (Qnil))->data;
194 195 196
  else
    user_name = "";
  if (STRINGP (Fsystem_name ()))
197
    host_name = (char *)XSTRING (Fsystem_name ())->data;
198 199
  else
    host_name = "";
200
  lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
201
				  + LOCK_PID_MAX + 5);
Richard M. Stallman's avatar
Richard M. Stallman committed
202

203 204 205 206 207 208 209
  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
210 211 212

  err = symlink (lock_info_str, lfname);
  if (errno == EEXIST && force)
213
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
214 215
      unlink (lfname);
      err = symlink (lock_info_str, lfname);
216 217
    }

Richard M. Stallman's avatar
Richard M. Stallman committed
218 219
  return err == 0;
}
220

Jim Blandy's avatar
Jim Blandy committed
221

Richard M. Stallman's avatar
Richard M. Stallman committed
222 223 224 225 226

/* 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.  */
227

Richard M. Stallman's avatar
Richard M. Stallman committed
228 229 230 231
static int
current_lock_owner (owner, lfname)
     lock_info_type *owner;
     char *lfname;
Jim Blandy's avatar
Jim Blandy committed
232
{
Richard M. Stallman's avatar
Richard M. Stallman committed
233 234 235 236 237
#ifndef index
  extern char *rindex (), *index ();
#endif
  int o, p, len, ret;
  int local_owner = 0;
238
  char *at, *dot, *colon;
Richard M. Stallman's avatar
Richard M. Stallman committed
239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
  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
257

Richard M. Stallman's avatar
Richard M. Stallman committed
258 259 260 261 262 263 264
  /* 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)
    {
265
      owner = (lock_info_type *) alloca (sizeof (lock_info_type));
Richard M. Stallman's avatar
Richard M. Stallman committed
266 267 268
      local_owner = 1;
    }
  
269
  /* Parse USER@HOST.PID:BOOT_TIME.  If can't parse, return -1.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
270 271 272
  /* The USER is everything before the first @.  */
  at = index (lfinfo, '@');
  dot = rindex (lfinfo, '.');
273 274 275 276 277
  if (!at || !dot)
    {
      xfree (lfinfo);
      return -1;
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
278 279 280 281 282
  len = at - lfinfo;
  owner->user = (char *) xmalloc (len + 1);
  strncpy (owner->user, lfinfo, len);
  owner->user[len] = 0;
  
283
  /* The PID is everything from the last `.' to the `:'.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
284
  owner->pid = atoi (dot + 1);
285 286 287 288 289 290 291 292
  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
293

Richard M. Stallman's avatar
Richard M. Stallman committed
294 295 296 297 298
  /* 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
299

Richard M. Stallman's avatar
Richard M. Stallman committed
300 301 302 303
  /* We're done looking at the link info.  */
  xfree (lfinfo);
  
  /* On current host?  */
304 305
  if (STRINGP (Fsystem_name ())
      && strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
Jim Blandy's avatar
Jim Blandy committed
306
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
307 308
      if (owner->pid == getpid ())
        ret = 2; /* We own it.  */
309
      else if (owner->pid > 0
310 311 312
               && (kill (owner->pid, 0) >= 0 || errno == EPERM)
	       && (owner->boot_time == 0
		   || owner->boot_time == get_boot_time ()))
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314 315
        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.  */
316
      else if (unlink (lfname) < 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
317
        ret = -1;
318 319
      else
	ret = 0;
Jim Blandy's avatar
Jim Blandy committed
320
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
321 322 323 324 325 326 327 328 329 330 331 332
  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
333 334
}

Richard M. Stallman's avatar
Richard M. Stallman committed
335 336 337 338 339 340

/* 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
341

Richard M. Stallman's avatar
Richard M. Stallman committed
342 343 344 345 346
static int
lock_if_free (clasher, lfname)
     lock_info_type *clasher;
     register char *lfname; 
{
347
  if (lock_file_1 (lfname, 0) == 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
348 349
    {
      int locker;
350

Richard M. Stallman's avatar
Richard M. Stallman committed
351 352 353 354 355 356 357 358 359 360 361 362
      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.  */

363
      return -1; /* Something's wrong.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
364 365
    }
  return 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
366 367
}

Richard M. Stallman's avatar
Richard M. Stallman committed
368
/* lock_file locks file FN,
Richard M. Stallman's avatar
Richard M. Stallman committed
369 370 371
   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
372
   Do not (normally) call this for a buffer already modified,
Richard M. Stallman's avatar
Richard M. Stallman committed
373 374 375
   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
376
   When this returns, either the lock is locked for us,
Richard M. Stallman's avatar
Richard M. Stallman committed
377 378
   or the user has said to go ahead without locking.

Richard M. Stallman's avatar
Richard M. Stallman committed
379
   If the file is locked by someone else, this calls
Richard M. Stallman's avatar
Richard M. Stallman committed
380
   ask-user-about-lock (a Lisp function) with two arguments,
Richard M. Stallman's avatar
Richard M. Stallman committed
381
   the file name and info about the user who did the locking.
Richard M. Stallman's avatar
Richard M. Stallman committed
382 383 384 385 386
   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
387
     Lisp_Object fn;
Richard M. Stallman's avatar
Richard M. Stallman committed
388
{
Richard M. Stallman's avatar
Richard M. Stallman committed
389
  register Lisp_Object attack, orig_fn, encoded_fn;
Richard M. Stallman's avatar
Richard M. Stallman committed
390 391
  register char *lfname, *locker;
  lock_info_type lock_info;
Richard M. Stallman's avatar
Richard M. Stallman committed
392

393
  orig_fn = fn;
394
  fn = Fexpand_file_name (fn, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
395
  encoded_fn = ENCODE_FILE (fn);
396

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

Jim Blandy's avatar
Jim Blandy committed
400 401
  /* See if this file is visited and has changed on disk since it was
     visited.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
402
  {
403
    register Lisp_Object subject_buf;
Richard M. Stallman's avatar
Richard M. Stallman committed
404
    struct gcpro gcpro1;
Richard M. Stallman's avatar
Richard M. Stallman committed
405

406
    subject_buf = get_truename_buffer (orig_fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
407 408
    GCPRO1 (fn);

Jim Blandy's avatar
Jim Blandy committed
409 410 411
    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
412
      call1 (intern ("ask-user-about-supersession-threat"), fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
413 414

    UNGCPRO;
Richard M. Stallman's avatar
Richard M. Stallman committed
415 416 417
  }

  /* Try to lock the lock. */
Richard M. Stallman's avatar
Richard M. Stallman committed
418 419
  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
420 421 422
    return;

  /* Else consider breaking the lock */
423 424
  locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
			    + LOCK_PID_MAX + 9);
425
  sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
Richard M. Stallman's avatar
Richard M. Stallman committed
426 427 428 429
           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
430
  if (!NILP (attack))
Richard M. Stallman's avatar
Richard M. Stallman committed
431 432
    /* User says take the lock */
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
433
      lock_file_1 (lfname, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
434 435 436 437 438 439 440 441 442 443 444
      return;
    }
  /* User says ignore the lock */
}

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

445
  fn = Fexpand_file_name (fn, Qnil);
446
  fn = ENCODE_FILE (fn);
447

448
  MAKE_LOCK_NAME (lfname, fn);
Richard M. Stallman's avatar
Richard M. Stallman committed
449

Richard M. Stallman's avatar
Richard M. Stallman committed
450
  if (current_lock_owner (0, lfname) == 2)
Richard M. Stallman's avatar
Richard M. Stallman committed
451 452 453 454 455 456 457 458 459
    unlink (lfname);
}

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

460
  for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
Richard M. Stallman's avatar
Richard M. Stallman committed
461 462
    {
      b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
463
      if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
464 465 466 467 468 469 470 471
	{
	  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
472 473 474 475 476 477 478 479
    }
}

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.")
480 481
  (file)
     Lisp_Object file;
Richard M. Stallman's avatar
Richard M. Stallman committed
482
{
483 484
  if (NILP (file))
    file = current_buffer->file_truename;
Richard M. Stallman's avatar
Richard M. Stallman committed
485
  else
486
    CHECK_STRING (file, 0);
487
  if (SAVE_MODIFF < MODIFF
488 489
      && !NILP (file))
    lock_file (file);
Richard M. Stallman's avatar
Richard M. Stallman committed
490 491 492 493 494 495 496 497 498
  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.")
  ()
{
499
  if (SAVE_MODIFF < MODIFF
500 501
      && STRINGP (current_buffer->file_truename))
    unlock_file (current_buffer->file_truename);
Richard M. Stallman's avatar
Richard M. Stallman committed
502 503 504 505 506
  return Qnil;
}

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

507
void
Richard M. Stallman's avatar
Richard M. Stallman committed
508 509 510
unlock_buffer (buffer)
     struct buffer *buffer;
{
511
  if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
512 513
      && STRINGP (buffer->file_truename))
    unlock_file (buffer->file_truename);
Richard M. Stallman's avatar
Richard M. Stallman committed
514 515 516 517 518
}

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.")
519 520
  (filename)
  Lisp_Object filename;
Richard M. Stallman's avatar
Richard M. Stallman committed
521
{
Richard M. Stallman's avatar
Richard M. Stallman committed
522
  Lisp_Object ret;
Richard M. Stallman's avatar
Richard M. Stallman committed
523 524
  register char *lfname;
  int owner;
Richard M. Stallman's avatar
Richard M. Stallman committed
525
  lock_info_type locker;
Richard M. Stallman's avatar
Richard M. Stallman committed
526

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

529
  MAKE_LOCK_NAME (lfname, filename);
Richard M. Stallman's avatar
Richard M. Stallman committed
530

Richard M. Stallman's avatar
Richard M. Stallman committed
531
  owner = current_lock_owner (&locker, lfname);
Richard M. Stallman's avatar
Richard M. Stallman committed
532
  if (owner <= 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
533 534 535 536 537 538 539 540 541 542
    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
543
}
Jim Blandy's avatar
Jim Blandy committed
544 545 546

/* Initialization functions.  */

Andreas Schwab's avatar
Andreas Schwab committed
547
void
Richard M. Stallman's avatar
Richard M. Stallman committed
548 549 550 551 552 553 554 555
syms_of_filelock ()
{
  defsubr (&Sunlock_buffer);
  defsubr (&Slock_buffer);
  defsubr (&Sfile_locked_p);
}

#endif /* CLASH_DETECTION */