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   int len, ret;
 417   int local_owner = 0;
 418   char *at, *dot, *colon;
 419   char *lfinfo = 0;
 420   int bufsize = 50;
 421   /* Read arbitrarily-long contents of symlink.  Similar code in
 422      file-symlink-p in fileio.c.  */
 423   do
 424     {
 425       bufsize *= 2;
 426       lfinfo = (char *) xrealloc (lfinfo, bufsize);
 427       errno = 0;
 428       len = readlink (lfname, lfinfo, bufsize);
 429 #ifdef ERANGE
 430       /* HP-UX reports ERANGE if the buffer is too small.  */
 431       if (len == -1 && errno == ERANGE)
 432         len = bufsize;
 433 #endif
 434     }
 435   while (len >= bufsize);
 436
 437   /* If nonexistent lock file, all is well; otherwise, got strange error. */
 438   if (len == -1)
 439     {
 440       xfree (lfinfo);
 441       return errno == ENOENT ? 0 : -1;
 442     }
 443
 444   /* Link info exists, so `len' is its length.  Null terminate.  */
 445   lfinfo[len] = 0;
 446
 447   /* Even if the caller doesn't want the owner info, we still have to
 448      read it to determine return value, so allocate it.  */
 449   if (!owner)
 450     {
 451       owner = (lock_info_type *) alloca (sizeof (lock_info_type));
 452       local_owner = 1;
 453     }
 454
 455   /* Parse USER@HOST.PID:BOOT_TIME.  If can't parse, return -1.  */
 456   /* The USER is everything before the last @.  */
 457   at = strrchr (lfinfo, '@');
 458   dot = strrchr (lfinfo, '.');
 459   if (!at || !dot)
 460     {
 461       xfree (lfinfo);
 462       return -1;
 463     }
 464   len = at - lfinfo;
 465   owner->user = (char *) xmalloc (len + 1);
 466   strncpy (owner->user, lfinfo, len);
 467   owner->user[len] = 0;
 468
 469   /* The PID is everything from the last `.' to the `:'.  */
 470   owner->pid = atoi (dot + 1);
 471   colon = dot;
 472   while (*colon && *colon != ':')
 473     colon++;
 474   /* After the `:', if there is one, comes the boot time.  */
 475   if (*colon == ':')
 476     owner->boot_time = atoi (colon + 1);
 477   else
 478     owner->boot_time = 0;
 479
 480   /* The host is everything in between.  */
 481   len = dot - at - 1;
 482   owner->host = (char *) xmalloc (len + 1);
 483   strncpy (owner->host, at + 1, len);
 484   owner->host[len] = 0;
 485
 486   /* We're done looking at the link info.  */
 487   xfree (lfinfo);
 488
 489   /* On current host?  */
 490   if (STRINGP (Fsystem_name ())
 491       && strcmp (owner->host, SDATA (Fsystem_name ())) == 0)
 492     {
 493       if (owner->pid == getpid ())
 494         ret = 2; /* We own it.  */
 495       else if (owner->pid > 0
 496                && (kill (owner->pid, 0) >= 0 || errno == EPERM)
 497                && (owner->boot_time == 0
 498                    || within_one_second (owner->boot_time, get_boot_time ())))
 499         ret = 1; /* An existing process on this machine owns it.  */
 500       /* The owner process is dead or has a strange pid (<=0), so try to
 501          zap the lockfile.  */
 502       else if (unlink (lfname) < 0)
 503         ret = -1;
 504       else
 505         ret = 0;
 506     }
 507   else
 508     { /* If we wanted to support the check for stale locks on remote machines,
 509          here's where we'd do it.  */
 510       ret = 1;
 511     }
 512
 513   /* Avoid garbage.  */
 514   if (local_owner || ret <= 0)
 515     {
 516       FREE_LOCK_INFO (*owner);
 517     }
 518   return ret;
 519 }
 520
 521 \f
 522 /* Lock the lock named LFNAME if possible.
 523    Return 0 in that case.
 524    Return positive if some other process owns the lock, and info about
 525      that process in CLASHER.
 526    Return -1 if cannot lock for any other reason.  */
 527
 528 static int
 529 lock_if_free (lock_info_type *clasher, register char *lfname)
 530 {
 531   while (lock_file_1 (lfname, 0) == 0)
 532     {
 533       int locker;
 534
 535       if (errno != EEXIST)
 536         return -1;
 537
 538       locker = current_lock_owner (clasher, lfname);
 539       if (locker == 2)
 540         {
 541           FREE_LOCK_INFO (*clasher);
 542           return 0;   /* We ourselves locked it.  */
 543         }
 544       else if (locker == 1)
 545         return 1;  /* Someone else has it.  */
 546       else if (locker == -1)
 547         return -1;   /* current_lock_owner returned strange error.  */
 548
 549       /* We deleted a stale lock; try again to lock the file.  */
 550     }
 551   return 0;
 552 }
 553
 554 /* lock_file locks file FN,
 555    meaning it serves notice on the world that you intend to edit that file.
 556    This should be done only when about to modify a file-visiting
 557    buffer previously unmodified.
 558    Do not (normally) call this for a buffer already modified,
 559    as either the file is already locked, or the user has already
 560    decided to go ahead without locking.
 561
 562    When this returns, either the lock is locked for us,
 563    or the user has said to go ahead without locking.
 564
 565    If the file is locked by someone else, this calls
 566    ask-user-about-lock (a Lisp function) with two arguments,
 567    the file name and info about the user who did the locking.
 568    This function can signal an error, or return t meaning
 569    take away the lock, or return nil meaning ignore the lock.  */
 570
 571 void
 572 lock_file (Lisp_Object fn)
 573 {
 574   register Lisp_Object attack, orig_fn, encoded_fn;
 575   register char *lfname, *locker;
 576   lock_info_type lock_info;
 577   struct gcpro gcpro1;
 578
 579   /* Don't do locking while dumping Emacs.
 580      Uncompressing wtmp files uses call-process, which does not work
 581      in an uninitialized Emacs.  */
 582   if (! NILP (Vpurify_flag))
 583     return;
 584
 585   orig_fn = fn;
 586   GCPRO1 (fn);
 587   fn = Fexpand_file_name (fn, Qnil);
 588   encoded_fn = ENCODE_FILE (fn);
 589
 590   /* Create the name of the lock-file for file fn */
 591   MAKE_LOCK_NAME (lfname, encoded_fn);
 592
 593   /* See if this file is visited and has changed on disk since it was
 594      visited.  */
 595   {
 596     register Lisp_Object subject_buf;
 597
 598     subject_buf = get_truename_buffer (orig_fn);
 599
 600     if (!NILP (subject_buf)
 601         && NILP (Fverify_visited_file_modtime (subject_buf))
 602         && !NILP (Ffile_exists_p (fn)))
 603       call1 (intern ("ask-user-about-supersession-threat"), fn);
 604
 605   }
 606   UNGCPRO;
 607
 608   /* Try to lock the lock. */
 609   if (lock_if_free (&lock_info, lfname) <= 0)
 610     /* Return now if we have locked it, or if lock creation failed */
 611     return;
 612
 613   /* Else consider breaking the lock */
 614   locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
 615                             + LOCK_PID_MAX + 9);
 616   sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
 617            lock_info.pid);
 618   FREE_LOCK_INFO (lock_info);
 619
 620   attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
 621   if (!NILP (attack))
 622     /* User says take the lock */
 623     {
 624       lock_file_1 (lfname, 1);
 625       return;
 626     }
 627   /* User says ignore the lock */
 628 }
 629
 630 void
 631 unlock_file (register Lisp_Object fn)
 632 {
 633   register char *lfname;
 634
 635   fn = Fexpand_file_name (fn, Qnil);
 636   fn = ENCODE_FILE (fn);
 637
 638   MAKE_LOCK_NAME (lfname, fn);
 639
 640   if (current_lock_owner (0, lfname) == 2)
 641     unlink (lfname);
 642 }
 643
 644 void
 645 unlock_all_files (void)
 646 {
 647   register Lisp_Object tail;
 648   register struct buffer *b;
 649
 650   for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
 651     {
 652       b = XBUFFER (XCDR (XCAR (tail)));
 653       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
 654         {
 655           unlock_file(b->file_truename);
 656         }
 657     }
 658 }
 659 \f
 660 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
 661        0, 1, 0,
 662        doc: /* Lock FILE, if current buffer is modified.
 663 FILE defaults to current buffer's visited file,
 664 or else nothing is done if current buffer isn't visiting a file.  */)
 665   (Lisp_Object file)
 666 {
 667   if (NILP (file))
 668     file = current_buffer->file_truename;
 669   else
 670     CHECK_STRING (file);
 671   if (SAVE_MODIFF < MODIFF
 672       && !NILP (file))
 673     lock_file (file);
 674   return Qnil;
 675 }
 676
 677 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
 678        0, 0, 0,
 679        doc: /* Unlock the file visited in the current buffer.
 680 If the buffer is not modified, this does nothing because the file
 681 should not be locked in that case.  */)
 682   (void)
 683 {
 684   if (SAVE_MODIFF < MODIFF
 685       && STRINGP (current_buffer->file_truename))
 686     unlock_file (current_buffer->file_truename);
 687   return Qnil;
 688 }
 689
 690 /* Unlock the file visited in buffer BUFFER.  */
 691
 692 void
 693 unlock_buffer (struct buffer *buffer)
 694 {
 695   if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
 696       && STRINGP (buffer->file_truename))
 697     unlock_file (buffer->file_truename);
 698 }
 699
 700 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
 701        doc: /* Return a value indicating whether FILENAME is locked.
 702 The value is nil if the FILENAME is not locked,
 703 t if it is locked by you, else a string saying which user has locked it.  */)
 704   (Lisp_Object filename)
 705 {
 706   Lisp_Object ret;
 707   register char *lfname;
 708   int owner;
 709   lock_info_type locker;
 710
 711   filename = Fexpand_file_name (filename, Qnil);
 712
 713   MAKE_LOCK_NAME (lfname, filename);
 714
 715   owner = current_lock_owner (&locker, lfname);
 716   if (owner <= 0)
 717     ret = Qnil;
 718   else if (owner == 2)
 719     ret = Qt;
 720   else
 721     ret = build_string (locker.user);
 722
 723   if (owner > 0)
 724     FREE_LOCK_INFO (locker);
 725
 726   return ret;
 727 }
 728 \f
 729 /* Initialization functions.  */
 730
 731 void
 732 init_filelock (void)
 733 {
 734   boot_time = 0;
 735   boot_time_initialized = 0;
 736 }
 737
 738 void
 739 syms_of_filelock (void)
 740 {
 741   DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory,
 742                doc: /* The directory for writing temporary files.  */);
 743   Vtemporary_file_directory = Qnil;
 744
 745   defsubr (&Sunlock_buffer);
 746   defsubr (&Slock_buffer);
 747   defsubr (&Sfile_locked_p);
 748 }
 749
 750 #endif /* CLASH_DETECTION */
 751
 752 /* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1
 753    (do not change this comment) */