src/filelock.c

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