src/filelock.c

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