src/filelock.c

   1 /* Lock files for editing.
   2    Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 1998, 1999, 2000, 2001,
   3                  2002, 2003, 2004, 2005, 2006, 2007, 2008
   4                  Free Software Foundation, Inc.
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 Boston, MA 02110-1301, USA.  */
  22
  23
  24 #include <config.h>
  25 #include <sys/types.h>
  26 #include <sys/stat.h>
  27 #include <signal.h>
  28 #include <stdio.h>
  29
  30 #ifdef HAVE_PWD_H
  31 #include <pwd.h>
  32 #endif
  33
  34 #include <sys/file.h>
  35 #ifdef HAVE_FCNTL_H
  36 #include <fcntl.h>
  37 #endif
  38 #ifdef HAVE_STRING_H
  39 #include <string.h>
  40 #endif
  41
  42 #ifdef HAVE_UNISTD_H
  43 #include <unistd.h>
  44 #endif
  45
  46 #ifdef __FreeBSD__
  47 #include <sys/sysctl.h>
  48 #endif /* __FreeBSD__ */
  49
  50 #include <errno.h>
  51 #ifndef errno
  52 extern int errno;
  53 #endif
  54
  55 #include "lisp.h"
  56 #include "buffer.h"
  57 #include "charset.h"
  58 #include "coding.h"
  59 #include "systime.h"
  60
  61 /* The directory for writing temporary files.  */
  62
  63 Lisp_Object Vtemporary_file_directory;
  64
  65 #ifdef CLASH_DETECTION
  66
  67 #include <utmp.h>
  68
  69 #if !defined (S_ISLNK) && defined (S_IFLNK)
  70 #define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
  71 #endif
  72
  73 /* A file whose last-modified time is just after the most recent boot.
  74    Define this to be NULL to disable checking for this file.  */
  75 #ifndef BOOT_TIME_FILE
  76 #define BOOT_TIME_FILE "/var/run/random-seed"
  77 #endif
  78
  79 #ifndef WTMP_FILE
  80 #define WTMP_FILE "/var/log/wtmp"
  81 #endif
  82
  83 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
  84    directory, with link data `user@host.pid'.  This avoids a single
  85    mount (== failure) point for lock files.
  86
  87    When the host in the lock data is the current host, we can check if
  88    the pid is valid with kill.
  89
  90    Otherwise, we could look at a separate file that maps hostnames to
  91    reboot times to see if the remote pid can possibly be valid, since we
  92    don't want Emacs to have to communicate via pipes or sockets or
  93    whatever to other processes, either locally or remotely; rms says
  94    that's too unreliable.  Hence the separate file, which could
  95    theoretically be updated by daemons running separately -- but this
  96    whole idea is unimplemented; in practice, at least in our
  97    environment, it seems such stale locks arise fairly infrequently, and
  98    Emacs' standard methods of dealing with clashes suffice.
  99
 100    We use symlinks instead of normal files because (1) they can be
 101    stored more efficiently on the filesystem, since the kernel knows
 102    they will be small, and (2) all the info about the lock can be read
 103    in a single system call (readlink).  Although we could use regular
 104    files to be useful on old systems lacking symlinks, nowadays
 105    virtually all such systems are probably single-user anyway, so it
 106    didn't seem worth the complication.
 107
 108    Similarly, we don't worry about a possible 14-character limit on
 109    file names, because those are all the same systems that don't have
 110    symlinks.
 111
 112    This is compatible with the locking scheme used by Interleaf (which
 113    has contributed this implementation for Emacs), and was designed by
 114    Ethan Jacobson, Kimbo Mundy, and others.
 115
 116    --karl@cs.umb.edu/karl@hq.ileaf.com.  */
 117
 118 \f
 119 /* Return the time of the last system boot.  */
 120
 121 static time_t boot_time;
 122 static int boot_time_initialized;
 123
 124 extern Lisp_Object Vshell_file_name;
 125
 126 #ifdef BOOT_TIME
 127 static void get_boot_time_1 P_ ((char *, int));
 128 #endif
 129
 130 static time_t
 131 get_boot_time ()
 132 {
 133 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
 134   int counter;
 135 #endif
 136
 137   if (boot_time_initialized)
 138     return boot_time;
 139   boot_time_initialized = 1;
 140
 141 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
 142   {
 143     int mib[2];
 144     size_t size;
 145     struct timeval boottime_val;
 146
 147     mib[0] = CTL_KERN;
 148     mib[1] = KERN_BOOTTIME;
 149     size = sizeof (boottime_val);
 150
 151     if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
 152       {
 153         boot_time = boottime_val.tv_sec;
 154         return boot_time;
 155       }
 156   }
 157 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
 158
 159   if (BOOT_TIME_FILE)
 160     {
 161       struct stat st;
 162       if (stat (BOOT_TIME_FILE, &st) == 0)
 163         {
 164           boot_time = st.st_mtime;
 165           return boot_time;
 166         }
 167     }
 168
 169 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
 170 #ifndef CANNOT_DUMP
 171   /* The utmp routines maintain static state.
 172      Don't touch that state unless we are initialized,
 173      since it might not survive dumping.  */
 174   if (! initialized)
 175     return boot_time;
 176 #endif /* not CANNOT_DUMP */
 177
 178   /* Try to get boot time from utmp before wtmp,
 179      since utmp is typically much smaller than wtmp.
 180      Passing a null pointer causes get_boot_time_1
 181      to inspect the default file, namely utmp.  */
 182   get_boot_time_1 ((char *) 0, 0);
 183   if (boot_time)
 184     return boot_time;
 185
 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       char cmd_string[100];
 193       Lisp_Object tempname, filename;
 194       int delete_flag = 0;
 195
 196       filename = Qnil;
 197
 198       sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
 199       tempname = build_string (cmd_string);
 200       if (! NILP (Ffile_exists_p (tempname)))
 201         filename = tempname;
 202       else
 203         {
 204           sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
 205           tempname = build_string (cmd_string);
 206           if (! NILP (Ffile_exists_p (tempname)))
 207             {
 208               Lisp_Object args[6];
 209
 210               /* The utmp functions on mescaline.gnu.org accept only
 211                  file names up to 8 characters long.  Choose a 2
 212                  character long prefix, and call make_temp_file with
 213                  second arg non-zero, so that it will add not more
 214                  than 6 characters to the prefix.  */
 215               tempname = Fexpand_file_name (build_string ("wt"),
 216                                             Vtemporary_file_directory);
 217               tempname = make_temp_name (tempname, 1);
 218               args[0] = Vshell_file_name;
 219               args[1] = Qnil;
 220               args[2] = Qnil;
 221               args[3] = Qnil;
 222               args[4] = build_string ("-c");
 223               sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
 224                        WTMP_FILE, counter, SDATA (tempname));
 225               args[5] = build_string (cmd_string);
 226               Fcall_process (6, args);
 227               filename = tempname;
 228               delete_flag = 1;
 229             }
 230         }
 231
 232       if (! NILP (filename))
 233         {
 234           get_boot_time_1 (SDATA (filename), 1);
 235           if (delete_flag)
 236             unlink (SDATA (filename));
 237         }
 238     }
 239
 240   return boot_time;
 241 #else
 242   return 0;
 243 #endif
 244 }
 245
 246 #ifdef BOOT_TIME
 247 /* Try to get the boot time from wtmp file FILENAME.
 248    This succeeds if that file contains a reboot record.
 249
 250    If FILENAME is zero, use the same file as before;
 251    if no FILENAME has ever been specified, this is the utmp file.
 252    Use the newest reboot record if NEWEST is nonzero,
 253    the first reboot record otherwise.
 254    Ignore all reboot records on or before BOOT_TIME.
 255    Success is indicated by setting BOOT_TIME to a larger value.  */
 256
 257 void
 258 get_boot_time_1 (filename, newest)
 259      char *filename;
 260      int newest;
 261 {
 262   struct utmp ut, *utp;
 263   int desc;
 264
 265   if (filename)
 266     {
 267       /* On some versions of IRIX, opening a nonexistent file name
 268          is likely to crash in the utmp routines.  */
 269       desc = emacs_open (filename, O_RDONLY, 0);
 270       if (desc < 0)
 271         return;
 272
 273       emacs_close (desc);
 274
 275       utmpname (filename);
 276     }
 277
 278   setutent ();
 279
 280   while (1)
 281     {
 282       /* Find the next reboot record.  */
 283       ut.ut_type = BOOT_TIME;
 284       utp = getutid (&ut);
 285       if (! utp)
 286         break;
 287       /* Compare reboot times and use the newest one.  */
 288       if (utp->ut_time > boot_time)
 289         {
 290           boot_time = utp->ut_time;
 291           if (! newest)
 292             break;
 293         }
 294       /* Advance on element in the file
 295          so that getutid won't repeat the same one.  */
 296       utp = getutent ();
 297       if (! utp)
 298         break;
 299     }
 300   endutent ();
 301 }
 302 #endif /* BOOT_TIME */
 303 \f
 304 /* Here is the structure that stores information about a lock.  */
 305
 306 typedef struct
 307 {
 308   char *user;
 309   char *host;
 310   unsigned long pid;
 311   time_t boot_time;
 312 } lock_info_type;
 313
 314 /* When we read the info back, we might need this much more,
 315    enough for decimal representation plus null.  */
 316 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
 317
 318 /* Free the two dynamically-allocated pieces in PTR.  */
 319 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
 320
 321
 322 /* Write the name of the lock file for FN into LFNAME.  Length will be
 323    that of FN plus two more for the leading `.#' plus 1 for the
 324    trailing period plus one for the digit after it plus one for the
 325    null.  */
 326 #define MAKE_LOCK_NAME(lock, file) \
 327   (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
 328    fill_in_lock_file_name (lock, (file)))
 329
 330 static void
 331 fill_in_lock_file_name (lockfile, fn)
 332      register char *lockfile;
 333      register Lisp_Object fn;
 334 {
 335   register char *p;
 336   struct stat st;
 337   int count = 0;
 338
 339   strcpy (lockfile, SDATA (fn));
 340
 341   /* Shift the nondirectory part of the file name (including the null)
 342      right two characters.  Here is one of the places where we'd have to
 343      do something to support 14-character-max file names.  */
 344   for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
 345     p[2] = *p;
 346
 347   /* Insert the `.#'.  */
 348   p[1] = '.';
 349   p[2] = '#';
 350
 351   p = p + strlen (p);
 352
 353   while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
 354     {
 355       if (count > 9)
 356         {
 357           *p = '\0';
 358           return;
 359         }
 360       sprintf (p, ".%d", count++);
 361     }
 362 }
 363
 364 /* Lock the lock file named LFNAME.
 365    If FORCE is nonzero, we do so even if it is already locked.
 366    Return 1 if successful, 0 if not.  */
 367
 368 static int
 369 lock_file_1 (lfname, force)
 370      char *lfname;
 371      int force;
 372 {
 373   register int err;
 374   time_t boot_time;
 375   char *user_name;
 376   char *host_name;
 377   char *lock_info_str;
 378
 379   /* Call this first because it can GC.  */
 380   boot_time = get_boot_time ();
 381
 382   if (STRINGP (Fuser_login_name (Qnil)))
 383     user_name = (char *)SDATA (Fuser_login_name (Qnil));
 384   else
 385     user_name = "";
 386   if (STRINGP (Fsystem_name ()))
 387     host_name = (char *)SDATA (Fsystem_name ());
 388   else
 389     host_name = "";
 390   lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
 391                                   + LOCK_PID_MAX + 30);
 392
 393   if (boot_time)
 394     sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name,
 395              (unsigned long) getpid (), (unsigned long) boot_time);
 396   else
 397     sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
 398              (unsigned long) getpid ());
 399
 400   err = symlink (lock_info_str, lfname);
 401   if (errno == EEXIST && force)
 402     {
 403       unlink (lfname);
 404       err = symlink (lock_info_str, lfname);
 405     }
 406
 407   return err == 0;
 408 }
 409
 410 /* Return 1 if times A and B are no more than one second apart.  */
 411
 412 int
 413 within_one_second (a, b)
 414      time_t a, b;
 415 {
 416   return (a - b >= -1 && a - b <= 1);
 417 }
 418 \f
 419 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
 420    1 if another process owns it (and set OWNER (if non-null) to info),
 421    2 if the current process owns it,
 422    or -1 if something is wrong with the locking mechanism.  */
 423
 424 static int
 425 current_lock_owner (owner, lfname)
 426      lock_info_type *owner;
 427      char *lfname;
 428 {
 429 #ifndef index
 430   extern char *rindex (), *index ();
 431 #endif
 432   int len, ret;
 433   int local_owner = 0;
 434   char *at, *dot, *colon;
 435   char *lfinfo = 0;
 436   int bufsize = 50;
 437   /* Read arbitrarily-long contents of symlink.  Similar code in
 438      file-symlink-p in fileio.c.  */
 439   do
 440     {
 441       bufsize *= 2;
 442       lfinfo = (char *) xrealloc (lfinfo, bufsize);
 443       errno = 0;
 444       len = readlink (lfname, lfinfo, bufsize);
 445 #ifdef ERANGE
 446       /* HP-UX reports ERANGE if the buffer is too small.  */
 447       if (len == -1 && errno == ERANGE)
 448         len = bufsize;
 449 #endif
 450     }
 451   while (len >= bufsize);
 452
 453   /* If nonexistent lock file, all is well; otherwise, got strange error. */
 454   if (len == -1)
 455     {
 456       xfree (lfinfo);
 457       return errno == ENOENT ? 0 : -1;
 458     }
 459
 460   /* Link info exists, so `len' is its length.  Null terminate.  */
 461   lfinfo[len] = 0;
 462
 463   /* Even if the caller doesn't want the owner info, we still have to
 464      read it to determine return value, so allocate it.  */
 465   if (!owner)
 466     {
 467       owner = (lock_info_type *) alloca (sizeof (lock_info_type));
 468       local_owner = 1;
 469     }
 470
 471   /* Parse USER@HOST.PID:BOOT_TIME.  If can't parse, return -1.  */
 472   /* The USER is everything before the last @.  */
 473   at = rindex (lfinfo, '@');
 474   dot = rindex (lfinfo, '.');
 475   if (!at || !dot)
 476     {
 477       xfree (lfinfo);
 478       return -1;
 479     }
 480   len = at - lfinfo;
 481   owner->user = (char *) xmalloc (len + 1);
 482   strncpy (owner->user, lfinfo, len);
 483   owner->user[len] = 0;
 484
 485   /* The PID is everything from the last `.' to the `:'.  */
 486   owner->pid = atoi (dot + 1);
 487   colon = dot;
 488   while (*colon && *colon != ':')
 489     colon++;
 490   /* After the `:', if there is one, comes the boot time.  */
 491   if (*colon == ':')
 492     owner->boot_time = atoi (colon + 1);
 493   else
 494     owner->boot_time = 0;
 495
 496   /* The host is everything in between.  */
 497   len = dot - at - 1;
 498   owner->host = (char *) xmalloc (len + 1);
 499   strncpy (owner->host, at + 1, len);
 500   owner->host[len] = 0;
 501
 502   /* We're done looking at the link info.  */
 503   xfree (lfinfo);
 504
 505   /* On current host?  */
 506   if (STRINGP (Fsystem_name ())
 507       && strcmp (owner->host, SDATA (Fsystem_name ())) == 0)
 508     {
 509       if (owner->pid == getpid ())
 510         ret = 2; /* We own it.  */
 511       else if (owner->pid > 0
 512                && (kill (owner->pid, 0) >= 0 || errno == EPERM)
 513                && (owner->boot_time == 0
 514                    || within_one_second (owner->boot_time, get_boot_time ())))
 515         ret = 1; /* An existing process on this machine owns it.  */
 516       /* The owner process is dead or has a strange pid (<=0), so try to
 517          zap the lockfile.  */
 518       else if (unlink (lfname) < 0)
 519         ret = -1;
 520       else
 521         ret = 0;
 522     }
 523   else
 524     { /* If we wanted to support the check for stale locks on remote machines,
 525          here's where we'd do it.  */
 526       ret = 1;
 527     }
 528
 529   /* Avoid garbage.  */
 530   if (local_owner || ret <= 0)
 531     {
 532       FREE_LOCK_INFO (*owner);
 533     }
 534   return ret;
 535 }
 536
 537 \f
 538 /* Lock the lock named LFNAME if possible.
 539    Return 0 in that case.
 540    Return positive if some other process owns the lock, and info about
 541      that process in CLASHER.
 542    Return -1 if cannot lock for any other reason.  */
 543
 544 static int
 545 lock_if_free (clasher, lfname)
 546      lock_info_type *clasher;
 547      register char *lfname;
 548 {
 549   while (lock_file_1 (lfname, 0) == 0)
 550     {
 551       int locker;
 552
 553       if (errno != EEXIST)
 554         return -1;
 555
 556       locker = current_lock_owner (clasher, lfname);
 557       if (locker == 2)
 558         {
 559           FREE_LOCK_INFO (*clasher);
 560           return 0;   /* We ourselves locked it.  */
 561         }
 562       else if (locker == 1)
 563         return 1;  /* Someone else has it.  */
 564       else if (locker == -1)
 565         return -1;   /* current_lock_owner returned strange error.  */
 566
 567       /* We deleted a stale lock; try again to lock the file.  */
 568     }
 569   return 0;
 570 }
 571
 572 /* lock_file locks file FN,
 573    meaning it serves notice on the world that you intend to edit that file.
 574    This should be done only when about to modify a file-visiting
 575    buffer previously unmodified.
 576    Do not (normally) call this for a buffer already modified,
 577    as either the file is already locked, or the user has already
 578    decided to go ahead without locking.
 579
 580    When this returns, either the lock is locked for us,
 581    or the user has said to go ahead without locking.
 582
 583    If the file is locked by someone else, this calls
 584    ask-user-about-lock (a Lisp function) with two arguments,
 585    the file name and info about the user who did the locking.
 586    This function can signal an error, or return t meaning
 587    take away the lock, or return nil meaning ignore the lock.  */
 588
 589 void
 590 lock_file (fn)
 591      Lisp_Object fn;
 592 {
 593   register Lisp_Object attack, orig_fn, encoded_fn;
 594   register char *lfname, *locker;
 595   lock_info_type lock_info;
 596   struct gcpro gcpro1;
 597
 598   /* Don't do locking while dumping Emacs.
 599      Uncompressing wtmp files uses call-process, which does not work
 600      in an uninitialized Emacs.  */
 601   if (! NILP (Vpurify_flag))
 602     return;
 603
 604   orig_fn = fn;
 605   GCPRO1 (fn);
 606   fn = Fexpand_file_name (fn, Qnil);
 607   encoded_fn = ENCODE_FILE (fn);
 608
 609   /* Create the name of the lock-file for file fn */
 610   MAKE_LOCK_NAME (lfname, encoded_fn);
 611
 612   /* See if this file is visited and has changed on disk since it was
 613      visited.  */
 614   {
 615     register Lisp_Object subject_buf;
 616
 617     subject_buf = get_truename_buffer (orig_fn);
 618
 619     if (!NILP (subject_buf)
 620         && NILP (Fverify_visited_file_modtime (subject_buf))
 621         && !NILP (Ffile_exists_p (fn)))
 622       call1 (intern ("ask-user-about-supersession-threat"), fn);
 623
 624   }
 625   UNGCPRO;
 626
 627   /* Try to lock the lock. */
 628   if (lock_if_free (&lock_info, lfname) <= 0)
 629     /* Return now if we have locked it, or if lock creation failed */
 630     return;
 631
 632   /* Else consider breaking the lock */
 633   locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
 634                             + LOCK_PID_MAX + 9);
 635   sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
 636            lock_info.pid);
 637   FREE_LOCK_INFO (lock_info);
 638
 639   attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
 640   if (!NILP (attack))
 641     /* User says take the lock */
 642     {
 643       lock_file_1 (lfname, 1);
 644       return;
 645     }
 646   /* User says ignore the lock */
 647 }
 648
 649 void
 650 unlock_file (fn)
 651      register Lisp_Object fn;
 652 {
 653   register char *lfname;
 654
 655   fn = Fexpand_file_name (fn, Qnil);
 656   fn = ENCODE_FILE (fn);
 657
 658   MAKE_LOCK_NAME (lfname, fn);
 659
 660   if (current_lock_owner (0, lfname) == 2)
 661     unlink (lfname);
 662 }
 663
 664 void
 665 unlock_all_files ()
 666 {
 667   register Lisp_Object tail;
 668   register struct buffer *b;
 669
 670   for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
 671     {
 672       b = XBUFFER (XCDR (XCAR (tail)));
 673       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 674         {
 675           unlock_file(b->file_truename);
 676         }
 677     }
 678 }
 679 \f
 680 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 681        0, 1, 0,
 682        doc: /* Lock FILE, if current buffer is modified.
 683 FILE defaults to current buffer's visited file,
 684 or else nothing is done if current buffer isn't visiting a file.  */)
 685      (file)
 686      Lisp_Object file;
 687 {
 688   if (NILP (file))
 689     file = current_buffer->file_truename;
 690   else
 691     CHECK_STRING (file);
 692   if (SAVE_MODIFF < MODIFF
 693       && !NILP (file))
 694     lock_file (file);
 695   return Qnil;
 696 }
 697
 698 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 699        0, 0, 0,
 700        doc: /* Unlock the file visited in the current buffer.
 701 If the buffer is not modified, this does nothing because the file
 702 should not be locked in that case.  */)
 703      ()
 704 {
 705   if (SAVE_MODIFF < MODIFF
 706       && STRINGP (current_buffer->file_truename))
 707     unlock_file (current_buffer->file_truename);
 708   return Qnil;
 709 }
 710
 711 /* Unlock the file visited in buffer BUFFER.  */
 712
 713 void
 714 unlock_buffer (buffer)
 715      struct buffer *buffer;
 716 {
 717   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 718       && STRINGP (buffer->file_truename))
 719     unlock_file (buffer->file_truename);
 720 }
 721
 722 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
 723        doc: /* Return a value indicating whether FILENAME is locked.
 724 The value is nil if the FILENAME is not locked,
 725 t if it is locked by you, else a string saying which user has locked it.  */)
 726      (filename)
 727      Lisp_Object filename;
 728 {
 729   Lisp_Object ret;
 730   register char *lfname;
 731   int owner;
 732   lock_info_type locker;
 733
 734   filename = Fexpand_file_name (filename, Qnil);
 735
 736   MAKE_LOCK_NAME (lfname, filename);
 737
 738   owner = current_lock_owner (&locker, lfname);
 739   if (owner <= 0)
 740     ret = Qnil;
 741   else if (owner == 2)
 742     ret = Qt;
 743   else
 744     ret = build_string (locker.user);
 745
 746   if (owner > 0)
 747     FREE_LOCK_INFO (locker);
 748
 749   return ret;
 750 }
 751 \f
 752 /* Initialization functions.  */
 753
 754 void
 755 init_filelock ()
 756 {
 757   boot_time = 0;
 758   boot_time_initialized = 0;
 759 }
 760
 761 void
 762 syms_of_filelock ()
 763 {
 764   DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory,
 765                doc: /* The directory for writing temporary files.  */);
 766   Vtemporary_file_directory = Qnil;
 767
 768   defsubr (&Sunlock_buffer);
 769   defsubr (&Slock_buffer);
 770   defsubr (&Sfile_locked_p);
 771 }
 772
 773 #endif /* CLASH_DETECTION */
 774
 775 /* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1
 776    (do not change this comment) */