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