Backport Tramp changes from trunk.
[emacs.git] / src / filelock.c
blob5252db09104dd78ffd260f57e9326245fd825d75
1 /* Lock files for editing.
3 Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2014
4 Free Software Foundation, Inc.
6 Author: Richard King
7 (according to authors.el)
9 This file is part of GNU Emacs.
11 GNU Emacs is free software: you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation, either version 3 of the License, or
14 (at your option) any later version.
16 GNU Emacs is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include <config.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
28 #include <signal.h>
29 #include <stdio.h>
31 #ifdef HAVE_PWD_H
32 #include <pwd.h>
33 #endif
35 #include <sys/file.h>
36 #include <fcntl.h>
37 #include <unistd.h>
39 #ifdef __FreeBSD__
40 #include <sys/sysctl.h>
41 #endif /* __FreeBSD__ */
43 #include <errno.h>
45 #include <c-ctype.h>
47 #include "lisp.h"
48 #include "character.h"
49 #include "buffer.h"
50 #include "coding.h"
51 #include "systime.h"
52 #ifdef WINDOWSNT
53 #include <share.h>
54 #include <sys/socket.h> /* for fcntl */
55 #include "w32.h" /* for dostounix_filename */
56 #endif
58 #ifdef CLASH_DETECTION
60 #ifdef HAVE_UTMP_H
61 #include <utmp.h>
62 #endif
64 /* A file whose last-modified time is just after the most recent boot.
65 Define this to be NULL to disable checking for this file. */
66 #ifndef BOOT_TIME_FILE
67 #define BOOT_TIME_FILE "/var/run/random-seed"
68 #endif
70 #ifndef WTMP_FILE
71 #define WTMP_FILE "/var/log/wtmp"
72 #endif
74 /* Normally use a symbolic link to represent a lock.
75 The strategy: to lock a file FN, create a symlink .#FN in FN's
76 directory, with link data `user@host.pid'. This avoids a single
77 mount (== failure) point for lock files.
79 When the host in the lock data is the current host, we can check if
80 the pid is valid with kill.
82 Otherwise, we could look at a separate file that maps hostnames to
83 reboot times to see if the remote pid can possibly be valid, since we
84 don't want Emacs to have to communicate via pipes or sockets or
85 whatever to other processes, either locally or remotely; rms says
86 that's too unreliable. Hence the separate file, which could
87 theoretically be updated by daemons running separately -- but this
88 whole idea is unimplemented; in practice, at least in our
89 environment, it seems such stale locks arise fairly infrequently, and
90 Emacs' standard methods of dealing with clashes suffice.
92 We use symlinks instead of normal files because (1) they can be
93 stored more efficiently on the filesystem, since the kernel knows
94 they will be small, and (2) all the info about the lock can be read
95 in a single system call (readlink). Although we could use regular
96 files to be useful on old systems lacking symlinks, nowadays
97 virtually all such systems are probably single-user anyway, so it
98 didn't seem worth the complication.
100 Similarly, we don't worry about a possible 14-character limit on
101 file names, because those are all the same systems that don't have
102 symlinks.
104 This is compatible with the locking scheme used by Interleaf (which
105 has contributed this implementation for Emacs), and was designed by
106 Ethan Jacobson, Kimbo Mundy, and others.
108 --karl@cs.umb.edu/karl@hq.ileaf.com.
110 On some file systems, notably those of MS-Windows, symbolic links
111 do not work well, so instead of a symlink .#FN -> 'user@host.pid',
112 the lock is a regular file .#FN with contents 'user@host.pid'. To
113 establish a lock, a nonce file is created and then renamed to .#FN.
114 On MS-Windows this renaming is atomic unless the lock is forcibly
115 acquired. On other systems the renaming is atomic if the lock is
116 forcibly acquired; if not, the renaming is done via hard links,
117 which is good enough for lock-file purposes.
119 To summarize, race conditions can occur with either:
121 * Forced locks on MS-Windows systems.
123 * Non-forced locks on non-MS-Windows systems that support neither
124 hard nor symbolic links. */
127 /* Return the time of the last system boot. */
129 static time_t boot_time;
130 static bool boot_time_initialized;
132 #ifdef BOOT_TIME
133 static void get_boot_time_1 (const char *, bool);
134 #endif
136 static time_t
137 get_boot_time (void)
139 #if defined (BOOT_TIME)
140 int counter;
141 #endif
143 if (boot_time_initialized)
144 return boot_time;
145 boot_time_initialized = 1;
147 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
149 int mib[2];
150 size_t size;
151 struct timeval boottime_val;
153 mib[0] = CTL_KERN;
154 mib[1] = KERN_BOOTTIME;
155 size = sizeof (boottime_val);
157 if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
159 boot_time = boottime_val.tv_sec;
160 return boot_time;
163 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
165 if (BOOT_TIME_FILE)
167 struct stat st;
168 if (stat (BOOT_TIME_FILE, &st) == 0)
170 boot_time = st.st_mtime;
171 return boot_time;
175 #if defined (BOOT_TIME)
176 #ifndef CANNOT_DUMP
177 /* The utmp routines maintain static state.
178 Don't touch that state unless we are initialized,
179 since it might not survive dumping. */
180 if (! initialized)
181 return boot_time;
182 #endif /* not CANNOT_DUMP */
184 /* Try to get boot time from utmp before wtmp,
185 since utmp is typically much smaller than wtmp.
186 Passing a null pointer causes get_boot_time_1
187 to inspect the default file, namely utmp. */
188 get_boot_time_1 (0, 0);
189 if (boot_time)
190 return boot_time;
192 /* Try to get boot time from the current wtmp file. */
193 get_boot_time_1 (WTMP_FILE, 1);
195 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
196 for (counter = 0; counter < 20 && ! boot_time; counter++)
198 char cmd_string[sizeof WTMP_FILE ".19.gz"];
199 Lisp_Object tempname, filename;
200 bool delete_flag = 0;
202 filename = Qnil;
204 tempname = make_formatted_string
205 (cmd_string, "%s.%d", WTMP_FILE, counter);
206 if (! NILP (Ffile_exists_p (tempname)))
207 filename = tempname;
208 else
210 tempname = make_formatted_string (cmd_string, "%s.%d.gz",
211 WTMP_FILE, counter);
212 if (! NILP (Ffile_exists_p (tempname)))
214 Lisp_Object args[6];
216 /* The utmp functions on mescaline.gnu.org accept only
217 file names up to 8 characters long. Choose a 2
218 character long prefix, and call make_temp_file with
219 second arg non-zero, so that it will add not more
220 than 6 characters to the prefix. */
221 filename = Fexpand_file_name (build_string ("wt"),
222 Vtemporary_file_directory);
223 filename = make_temp_name (filename, 1);
224 args[0] = build_string ("gzip");
225 args[1] = Qnil;
226 args[2] = list2 (QCfile, filename);
227 args[3] = Qnil;
228 args[4] = build_string ("-cd");
229 args[5] = tempname;
230 Fcall_process (6, args);
231 delete_flag = 1;
235 if (! NILP (filename))
237 get_boot_time_1 (SSDATA (filename), 1);
238 if (delete_flag)
239 unlink (SSDATA (filename));
243 return boot_time;
244 #else
245 return 0;
246 #endif
249 #ifdef BOOT_TIME
250 /* Try to get the boot time from wtmp file FILENAME.
251 This succeeds if that file contains a reboot record.
253 If FILENAME is zero, use the same file as before;
254 if no FILENAME has ever been specified, this is the utmp file.
255 Use the newest reboot record if NEWEST,
256 the first reboot record otherwise.
257 Ignore all reboot records on or before BOOT_TIME.
258 Success is indicated by setting BOOT_TIME to a larger value. */
260 void
261 get_boot_time_1 (const char *filename, bool newest)
263 struct utmp ut, *utp;
265 if (filename)
267 /* On some versions of IRIX, opening a nonexistent file name
268 is likely to crash in the utmp routines. */
269 if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0)
270 return;
272 utmpname (filename);
275 setutent ();
277 while (1)
279 /* Find the next reboot record. */
280 ut.ut_type = BOOT_TIME;
281 utp = getutid (&ut);
282 if (! utp)
283 break;
284 /* Compare reboot times and use the newest one. */
285 if (utp->ut_time > boot_time)
287 boot_time = utp->ut_time;
288 if (! newest)
289 break;
291 /* Advance on element in the file
292 so that getutid won't repeat the same one. */
293 utp = getutent ();
294 if (! utp)
295 break;
297 endutent ();
299 #endif /* BOOT_TIME */
301 /* An arbitrary limit on lock contents length. 8 K should be plenty
302 big enough in practice. */
303 enum { MAX_LFINFO = 8 * 1024 };
305 /* Here is the structure that stores information about a lock. */
307 typedef struct
309 /* Location of '@', '.', ':' in USER. If there's no colon, COLON
310 points to the end of USER. */
311 char *at, *dot, *colon;
313 /* Lock file contents USER@HOST.PID with an optional :BOOT_TIME
314 appended. This memory is used as a lock file contents buffer, so
315 it needs room for MAX_LFINFO + 1 bytes. A string " (pid NNNN)"
316 may be appended to the USER@HOST while generating a diagnostic,
317 so make room for its extra bytes (as opposed to ".NNNN") too. */
318 char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
319 } lock_info_type;
321 /* Write the name of the lock file for FNAME into LOCKNAME. Length
322 will be that of FNAME plus two more for the leading ".#", plus one
323 for the null. */
324 #define MAKE_LOCK_NAME(lockname, fname) \
325 (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \
326 fill_in_lock_file_name (lockname, fname))
328 static void
329 fill_in_lock_file_name (char *lockfile, Lisp_Object fn)
331 char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn));
332 char *base = last_slash + 1;
333 ptrdiff_t dirlen = base - SSDATA (fn);
334 memcpy (lockfile, SSDATA (fn), dirlen);
335 lockfile[dirlen] = '.';
336 lockfile[dirlen + 1] = '#';
337 strcpy (lockfile + dirlen + 2, base);
340 /* For some reason Linux kernels return EPERM on file systems that do
341 not support hard or symbolic links. This symbol documents the quirk.
342 There is no way to tell whether a symlink call fails due to
343 permissions issues or because links are not supported, but luckily
344 the lock file code should work either way. */
345 enum { LINKS_MIGHT_NOT_WORK = EPERM };
347 /* Rename OLD to NEW. If FORCE, replace any existing NEW.
348 It is OK if there are temporarily two hard links to OLD.
349 Return 0 if successful, -1 (setting errno) otherwise. */
350 static int
351 rename_lock_file (char const *old, char const *new, bool force)
353 #ifdef WINDOWSNT
354 return sys_rename_replace (old, new, force);
355 #else
356 if (! force)
358 struct stat st;
360 if (link (old, new) == 0)
361 return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
362 if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)
363 return -1;
365 /* 'link' does not work on this file system. This can occur on
366 a GNU/Linux host mounting a FAT32 file system. Fall back on
367 'rename' after checking that NEW does not exist. There is a
368 potential race condition since some other process may create
369 NEW immediately after the existence check, but it's the best
370 we can portably do here. */
371 if (lstat (new, &st) == 0 || errno == EOVERFLOW)
373 errno = EEXIST;
374 return -1;
376 if (errno != ENOENT)
377 return -1;
380 return rename (old, new);
381 #endif
384 /* Create the lock file LFNAME with contents LOCK_INFO_STR. Return 0 if
385 successful, an errno value on failure. If FORCE, remove any
386 existing LFNAME if necessary. */
388 static int
389 create_lock_file (char *lfname, char *lock_info_str, bool force)
391 #ifdef WINDOWSNT
392 /* Symlinks are supported only by later versions of Windows, and
393 creating them is a privileged operation that often triggers
394 User Account Control elevation prompts. Avoid the problem by
395 pretending that 'symlink' does not work. */
396 int err = ENOSYS;
397 #else
398 int err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
399 #endif
401 if (err == EEXIST && force)
403 unlink (lfname);
404 err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
407 if (err == ENOSYS || err == LINKS_MIGHT_NOT_WORK || err == ENAMETOOLONG)
409 static char const nonce_base[] = ".#-emacsXXXXXX";
410 char *last_slash = strrchr (lfname, '/');
411 ptrdiff_t lfdirlen = last_slash + 1 - lfname;
412 USE_SAFE_ALLOCA;
413 char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base);
414 int fd;
415 memcpy (nonce, lfname, lfdirlen);
416 strcpy (nonce + lfdirlen, nonce_base);
418 fd = mkostemp (nonce, O_BINARY | O_CLOEXEC);
419 if (fd < 0)
420 err = errno;
421 else
423 ptrdiff_t lock_info_len;
424 if (! O_CLOEXEC)
425 fcntl (fd, F_SETFD, FD_CLOEXEC);
426 lock_info_len = strlen (lock_info_str);
427 err = 0;
428 /* Use 'write', not 'emacs_write', as garbage collection
429 might signal an error, which would leak FD. */
430 if (write (fd, lock_info_str, lock_info_len) != lock_info_len
431 || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
432 err = errno;
433 /* There is no need to call fsync here, as the contents of
434 the lock file need not survive system crashes. */
435 if (emacs_close (fd) != 0)
436 err = errno;
437 if (!err && rename_lock_file (nonce, lfname, force) != 0)
438 err = errno;
439 if (err)
440 unlink (nonce);
443 SAFE_FREE ();
446 return err;
449 /* Lock the lock file named LFNAME.
450 If FORCE, do so even if it is already locked.
451 Return 0 if successful, an error number on failure. */
453 static int
454 lock_file_1 (char *lfname, bool force)
456 /* Call this first because it can GC. */
457 printmax_t boot = get_boot_time ();
459 Lisp_Object luser_name = Fuser_login_name (Qnil);
460 char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
461 Lisp_Object lhost_name = Fsystem_name ();
462 char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : "";
463 char lock_info_str[MAX_LFINFO + 1];
464 printmax_t pid = getpid ();
466 if (boot)
468 if (sizeof lock_info_str
469 <= snprintf (lock_info_str, sizeof lock_info_str,
470 "%s@%s.%"pMd":%"pMd,
471 user_name, host_name, pid, boot))
472 return ENAMETOOLONG;
474 else if (sizeof lock_info_str
475 <= snprintf (lock_info_str, sizeof lock_info_str,
476 "%s@%s.%"pMd,
477 user_name, host_name, pid))
478 return ENAMETOOLONG;
480 return create_lock_file (lfname, lock_info_str, force);
483 /* Return true if times A and B are no more than one second apart. */
485 static bool
486 within_one_second (time_t a, time_t b)
488 return (a - b >= -1 && a - b <= 1);
491 /* On systems lacking ELOOP, test for an errno value that shouldn't occur. */
492 #ifndef ELOOP
493 # define ELOOP (-1)
494 #endif
496 /* Read the data for the lock file LFNAME into LFINFO. Read at most
497 MAX_LFINFO + 1 bytes. Return the number of bytes read, or -1
498 (setting errno) on error. */
500 static ptrdiff_t
501 read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
503 ptrdiff_t nbytes;
505 while ((nbytes = readlinkat (AT_FDCWD, lfname, lfinfo, MAX_LFINFO + 1)) < 0
506 && errno == EINVAL)
508 int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0);
509 if (0 <= fd)
511 /* Use read, not emacs_read, since FD isn't unwind-protected. */
512 ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
513 int read_errno = errno;
514 if (emacs_close (fd) != 0)
515 return -1;
516 errno = read_errno;
517 return read_bytes;
520 if (errno != ELOOP)
521 return -1;
523 /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
524 The former must have been removed and replaced by the latter.
525 Try again. */
526 QUIT;
529 return nbytes;
532 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
533 1 if another process owns it (and set OWNER (if non-null) to info),
534 2 if the current process owns it,
535 or -1 if something is wrong with the locking mechanism. */
537 static int
538 current_lock_owner (lock_info_type *owner, char *lfname)
540 int ret;
541 lock_info_type local_owner;
542 ptrdiff_t lfinfolen;
543 intmax_t pid, boot_time;
544 char *at, *dot, *lfinfo_end;
546 /* Even if the caller doesn't want the owner info, we still have to
547 read it to determine return value. */
548 if (!owner)
549 owner = &local_owner;
551 /* If nonexistent lock file, all is well; otherwise, got strange error. */
552 lfinfolen = read_lock_data (lfname, owner->user);
553 if (lfinfolen < 0)
554 return errno == ENOENT ? 0 : -1;
555 if (MAX_LFINFO < lfinfolen)
556 return -1;
557 owner->user[lfinfolen] = 0;
559 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
560 /* The USER is everything before the last @. */
561 owner->at = at = memrchr (owner->user, '@', lfinfolen);
562 if (!at)
563 return -1;
564 owner->dot = dot = strrchr (at, '.');
565 if (!dot)
566 return -1;
568 /* The PID is everything from the last `.' to the `:'. */
569 if (! c_isdigit (dot[1]))
570 return -1;
571 errno = 0;
572 pid = strtoimax (dot + 1, &owner->colon, 10);
573 if (errno == ERANGE)
574 pid = -1;
576 /* After the `:', if there is one, comes the boot time. */
577 switch (owner->colon[0])
579 case 0:
580 boot_time = 0;
581 lfinfo_end = owner->colon;
582 break;
584 case ':':
585 if (! c_isdigit (owner->colon[1]))
586 return -1;
587 boot_time = strtoimax (owner->colon + 1, &lfinfo_end, 10);
588 break;
590 default:
591 return -1;
593 if (lfinfo_end != owner->user + lfinfolen)
594 return -1;
596 /* On current host? */
597 if (STRINGP (Vsystem_name)
598 && dot - (at + 1) == SBYTES (Vsystem_name)
599 && memcmp (at + 1, SSDATA (Vsystem_name), SBYTES (Vsystem_name)) == 0)
601 if (pid == getpid ())
602 ret = 2; /* We own it. */
603 else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t)
604 && (kill (pid, 0) >= 0 || errno == EPERM)
605 && (boot_time == 0
606 || (boot_time <= TYPE_MAXIMUM (time_t)
607 && within_one_second (boot_time, get_boot_time ()))))
608 ret = 1; /* An existing process on this machine owns it. */
609 /* The owner process is dead or has a strange pid, so try to
610 zap the lockfile. */
611 else
612 return unlink (lfname);
614 else
615 { /* If we wanted to support the check for stale locks on remote machines,
616 here's where we'd do it. */
617 ret = 1;
620 return ret;
624 /* Lock the lock named LFNAME if possible.
625 Return 0 in that case.
626 Return positive if some other process owns the lock, and info about
627 that process in CLASHER.
628 Return -1 if cannot lock for any other reason. */
630 static int
631 lock_if_free (lock_info_type *clasher, char *lfname)
633 int err;
634 while ((err = lock_file_1 (lfname, 0)) == EEXIST)
636 switch (current_lock_owner (clasher, lfname))
638 case 2:
639 return 0; /* We ourselves locked it. */
640 case 1:
641 return 1; /* Someone else has it. */
642 case -1:
643 return -1; /* current_lock_owner returned strange error. */
646 /* We deleted a stale lock; try again to lock the file. */
649 return err ? -1 : 0;
652 /* lock_file locks file FN,
653 meaning it serves notice on the world that you intend to edit that file.
654 This should be done only when about to modify a file-visiting
655 buffer previously unmodified.
656 Do not (normally) call this for a buffer already modified,
657 as either the file is already locked, or the user has already
658 decided to go ahead without locking.
660 When this returns, either the lock is locked for us,
661 or lock creation failed,
662 or the user has said to go ahead without locking.
664 If the file is locked by someone else, this calls
665 ask-user-about-lock (a Lisp function) with two arguments,
666 the file name and info about the user who did the locking.
667 This function can signal an error, or return t meaning
668 take away the lock, or return nil meaning ignore the lock. */
670 void
671 lock_file (Lisp_Object fn)
673 Lisp_Object orig_fn, encoded_fn;
674 char *lfname;
675 lock_info_type lock_info;
676 struct gcpro gcpro1;
677 USE_SAFE_ALLOCA;
679 /* Don't do locking if the user has opted out. */
680 if (! create_lockfiles)
681 return;
683 /* Don't do locking while dumping Emacs.
684 Uncompressing wtmp files uses call-process, which does not work
685 in an uninitialized Emacs. */
686 if (! NILP (Vpurify_flag))
687 return;
689 orig_fn = fn;
690 GCPRO1 (fn);
691 fn = Fexpand_file_name (fn, Qnil);
692 #ifdef WINDOWSNT
693 /* Ensure we have only '/' separators, to avoid problems with
694 looking (inside fill_in_lock_file_name) for backslashes in file
695 names encoded by some DBCS codepage. */
696 dostounix_filename (SSDATA (fn));
697 #endif
698 encoded_fn = ENCODE_FILE (fn);
700 /* Create the name of the lock-file for file fn */
701 MAKE_LOCK_NAME (lfname, encoded_fn);
703 /* See if this file is visited and has changed on disk since it was
704 visited. */
706 register Lisp_Object subject_buf;
708 subject_buf = get_truename_buffer (orig_fn);
710 if (!NILP (subject_buf)
711 && NILP (Fverify_visited_file_modtime (subject_buf))
712 && !NILP (Ffile_exists_p (fn)))
713 call1 (intern ("ask-user-about-supersession-threat"), fn);
717 /* Try to lock the lock. */
718 if (0 < lock_if_free (&lock_info, lfname))
720 /* Someone else has the lock. Consider breaking it. */
721 Lisp_Object attack;
722 char *dot = lock_info.dot;
723 ptrdiff_t pidlen = lock_info.colon - (dot + 1);
724 static char const replacement[] = " (pid ";
725 int replacementlen = sizeof replacement - 1;
726 memmove (dot + replacementlen, dot + 1, pidlen);
727 strcpy (dot + replacementlen + pidlen, ")");
728 memcpy (dot, replacement, replacementlen);
729 attack = call2 (intern ("ask-user-about-lock"), fn,
730 build_string (lock_info.user));
731 /* Take the lock if the user said so. */
732 if (!NILP (attack))
733 lock_file_1 (lfname, 1);
736 UNGCPRO;
737 SAFE_FREE ();
740 void
741 unlock_file (Lisp_Object fn)
743 char *lfname;
744 USE_SAFE_ALLOCA;
746 fn = Fexpand_file_name (fn, Qnil);
747 fn = ENCODE_FILE (fn);
749 MAKE_LOCK_NAME (lfname, fn);
751 if (current_lock_owner (0, lfname) == 2)
752 unlink (lfname);
754 SAFE_FREE ();
757 void
758 unlock_all_files (void)
760 register Lisp_Object tail, buf;
761 register struct buffer *b;
763 FOR_EACH_LIVE_BUFFER (tail, buf)
765 b = XBUFFER (buf);
766 if (STRINGP (BVAR (b, file_truename))
767 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
768 unlock_file (BVAR (b, file_truename));
772 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
773 0, 1, 0,
774 doc: /* Lock FILE, if current buffer is modified.
775 FILE defaults to current buffer's visited file,
776 or else nothing is done if current buffer isn't visiting a file. */)
777 (Lisp_Object file)
779 if (NILP (file))
780 file = BVAR (current_buffer, file_truename);
781 else
782 CHECK_STRING (file);
783 if (SAVE_MODIFF < MODIFF
784 && !NILP (file))
785 lock_file (file);
786 return Qnil;
789 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
790 0, 0, 0,
791 doc: /* Unlock the file visited in the current buffer.
792 If the buffer is not modified, this does nothing because the file
793 should not be locked in that case. */)
794 (void)
796 if (SAVE_MODIFF < MODIFF
797 && STRINGP (BVAR (current_buffer, file_truename)))
798 unlock_file (BVAR (current_buffer, file_truename));
799 return Qnil;
802 /* Unlock the file visited in buffer BUFFER. */
804 void
805 unlock_buffer (struct buffer *buffer)
807 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
808 && STRINGP (BVAR (buffer, file_truename)))
809 unlock_file (BVAR (buffer, file_truename));
812 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
813 doc: /* Return a value indicating whether FILENAME is locked.
814 The value is nil if the FILENAME is not locked,
815 t if it is locked by you, else a string saying which user has locked it. */)
816 (Lisp_Object filename)
818 Lisp_Object ret;
819 char *lfname;
820 int owner;
821 lock_info_type locker;
822 USE_SAFE_ALLOCA;
824 filename = Fexpand_file_name (filename, Qnil);
826 MAKE_LOCK_NAME (lfname, filename);
828 owner = current_lock_owner (&locker, lfname);
829 if (owner <= 0)
830 ret = Qnil;
831 else if (owner == 2)
832 ret = Qt;
833 else
834 ret = make_string (locker.user, locker.at - locker.user);
836 SAFE_FREE ();
837 return ret;
840 #endif /* CLASH_DETECTION */
842 void
843 syms_of_filelock (void)
845 DEFVAR_LISP ("temporary-file-directory", Vtemporary_file_directory,
846 doc: /* The directory for writing temporary files. */);
847 Vtemporary_file_directory = Qnil;
849 DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
850 doc: /* Non-nil means use lockfiles to avoid editing collisions. */);
851 create_lockfiles = 1;
853 #ifdef CLASH_DETECTION
854 defsubr (&Sunlock_buffer);
855 defsubr (&Slock_buffer);
856 defsubr (&Sfile_locked_p);
857 #endif