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