* lisp/progmodes/cc-*.el: Fix up commenting style
[emacs.git] / src / filelock.c
blob4ee7a01ecb8e3f2937085337e8262c0cfb278a8e
1 /* Lock files for editing.
3 Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2015 Free Software
4 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 HAVE_UTMP_H
59 #include <utmp.h>
60 #endif
62 /* A file whose last-modified time is just after the most recent boot.
63 Define this to be NULL to disable checking for this file. */
64 #ifndef BOOT_TIME_FILE
65 #define BOOT_TIME_FILE "/var/run/random-seed"
66 #endif
68 #ifndef WTMP_FILE
69 #define WTMP_FILE "/var/log/wtmp"
70 #endif
72 /* Normally use a symbolic link to represent a lock.
73 The strategy: to lock a file FN, create a symlink .#FN in FN's
74 directory, with link data `user@host.pid'. This avoids a single
75 mount (== failure) point for lock files.
77 When the host in the lock data is the current host, we can check if
78 the pid is valid with kill.
80 Otherwise, we could look at a separate file that maps hostnames to
81 reboot times to see if the remote pid can possibly be valid, since we
82 don't want Emacs to have to communicate via pipes or sockets or
83 whatever to other processes, either locally or remotely; rms says
84 that's too unreliable. Hence the separate file, which could
85 theoretically be updated by daemons running separately -- but this
86 whole idea is unimplemented; in practice, at least in our
87 environment, it seems such stale locks arise fairly infrequently, and
88 Emacs' standard methods of dealing with clashes suffice.
90 We use symlinks instead of normal files because (1) they can be
91 stored more efficiently on the filesystem, since the kernel knows
92 they will be small, and (2) all the info about the lock can be read
93 in a single system call (readlink). Although we could use regular
94 files to be useful on old systems lacking symlinks, nowadays
95 virtually all such systems are probably single-user anyway, so it
96 didn't seem worth the complication.
98 Similarly, we don't worry about a possible 14-character limit on
99 file names, because those are all the same systems that don't have
100 symlinks.
102 This is compatible with the locking scheme used by Interleaf (which
103 has contributed this implementation for Emacs), and was designed by
104 Ethan Jacobson, Kimbo Mundy, and others.
106 --karl@cs.umb.edu/karl@hq.ileaf.com.
108 On some file systems, notably those of MS-Windows, symbolic links
109 do not work well, so instead of a symlink .#FN -> 'user@host.pid',
110 the lock is a regular file .#FN with contents 'user@host.pid'. To
111 establish a lock, a nonce file is created and then renamed to .#FN.
112 On MS-Windows this renaming is atomic unless the lock is forcibly
113 acquired. On other systems the renaming is atomic if the lock is
114 forcibly acquired; if not, the renaming is done via hard links,
115 which is good enough for lock-file purposes.
117 To summarize, race conditions can occur with either:
119 * Forced locks on MS-Windows systems.
121 * Non-forced locks on non-MS-Windows systems that support neither
122 hard nor symbolic links. */
125 /* Return the time of the last system boot. */
127 static time_t boot_time;
128 static bool boot_time_initialized;
130 #ifdef BOOT_TIME
131 static void get_boot_time_1 (const char *, bool);
132 #endif
134 static time_t
135 get_boot_time (void)
137 #if defined (BOOT_TIME)
138 int counter;
139 #endif
141 if (boot_time_initialized)
142 return boot_time;
143 boot_time_initialized = 1;
145 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
147 int mib[2];
148 size_t size;
149 struct timeval boottime_val;
151 mib[0] = CTL_KERN;
152 mib[1] = KERN_BOOTTIME;
153 size = sizeof (boottime_val);
155 if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
157 boot_time = boottime_val.tv_sec;
158 return boot_time;
161 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
163 if (BOOT_TIME_FILE)
165 struct stat st;
166 if (stat (BOOT_TIME_FILE, &st) == 0)
168 boot_time = st.st_mtime;
169 return boot_time;
173 #if defined (BOOT_TIME)
174 #ifndef CANNOT_DUMP
175 /* The utmp routines maintain static state.
176 Don't touch that state unless we are initialized,
177 since it might not survive dumping. */
178 if (! initialized)
179 return boot_time;
180 #endif /* not CANNOT_DUMP */
182 /* Try to get boot time from utmp before wtmp,
183 since utmp is typically much smaller than wtmp.
184 Passing a null pointer causes get_boot_time_1
185 to inspect the default file, namely utmp. */
186 get_boot_time_1 (0, 0);
187 if (boot_time)
188 return boot_time;
190 /* Try to get boot time from the current wtmp file. */
191 get_boot_time_1 (WTMP_FILE, 1);
193 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
194 for (counter = 0; counter < 20 && ! boot_time; counter++)
196 char cmd_string[sizeof WTMP_FILE ".19.gz"];
197 Lisp_Object tempname, filename;
198 bool delete_flag = 0;
200 filename = Qnil;
202 tempname = make_formatted_string
203 (cmd_string, "%s.%d", WTMP_FILE, counter);
204 if (! NILP (Ffile_exists_p (tempname)))
205 filename = tempname;
206 else
208 tempname = make_formatted_string (cmd_string, "%s.%d.gz",
209 WTMP_FILE, counter);
210 if (! NILP (Ffile_exists_p (tempname)))
212 /* The utmp functions on mescaline.gnu.org accept only
213 file names up to 8 characters long. Choose a 2
214 character long prefix, and call make_temp_file with
215 second arg non-zero, so that it will add not more
216 than 6 characters to the prefix. */
217 filename = Fexpand_file_name (build_string ("wt"),
218 Vtemporary_file_directory);
219 filename = make_temp_name (filename, 1);
220 CALLN (Fcall_process, build_string ("gzip"), Qnil,
221 list2 (QCfile, filename), Qnil,
222 build_string ("-cd"), tempname);
223 delete_flag = 1;
227 if (! NILP (filename))
229 get_boot_time_1 (SSDATA (filename), 1);
230 if (delete_flag)
231 unlink (SSDATA (filename));
235 return boot_time;
236 #else
237 return 0;
238 #endif
241 #ifdef BOOT_TIME
242 /* Try to get the boot time from wtmp file FILENAME.
243 This succeeds if that file contains a reboot record.
245 If FILENAME is zero, use the same file as before;
246 if no FILENAME has ever been specified, this is the utmp file.
247 Use the newest reboot record if NEWEST,
248 the first reboot record otherwise.
249 Ignore all reboot records on or before BOOT_TIME.
250 Success is indicated by setting BOOT_TIME to a larger value. */
252 void
253 get_boot_time_1 (const char *filename, bool newest)
255 struct utmp ut, *utp;
257 if (filename)
259 /* On some versions of IRIX, opening a nonexistent file name
260 is likely to crash in the utmp routines. */
261 if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0)
262 return;
264 utmpname (filename);
267 setutent ();
269 while (1)
271 /* Find the next reboot record. */
272 ut.ut_type = BOOT_TIME;
273 utp = getutid (&ut);
274 if (! utp)
275 break;
276 /* Compare reboot times and use the newest one. */
277 if (utp->ut_time > boot_time)
279 boot_time = utp->ut_time;
280 if (! newest)
281 break;
283 /* Advance on element in the file
284 so that getutid won't repeat the same one. */
285 utp = getutent ();
286 if (! utp)
287 break;
289 endutent ();
291 #endif /* BOOT_TIME */
293 /* An arbitrary limit on lock contents length. 8 K should be plenty
294 big enough in practice. */
295 enum { MAX_LFINFO = 8 * 1024 };
297 /* Here is the structure that stores information about a lock. */
299 typedef struct
301 /* Location of '@', '.', ':' in USER. If there's no colon, COLON
302 points to the end of USER. */
303 char *at, *dot, *colon;
305 /* Lock file contents USER@HOST.PID with an optional :BOOT_TIME
306 appended. This memory is used as a lock file contents buffer, so
307 it needs room for MAX_LFINFO + 1 bytes. A string " (pid NNNN)"
308 may be appended to the USER@HOST while generating a diagnostic,
309 so make room for its extra bytes (as opposed to ".NNNN") too. */
310 char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
311 } lock_info_type;
313 /* Write the name of the lock file for FNAME into LOCKNAME. Length
314 will be that of FNAME plus two more for the leading ".#", plus one
315 for the null. */
316 #define MAKE_LOCK_NAME(lockname, fname) \
317 (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \
318 fill_in_lock_file_name (lockname, fname))
320 static void
321 fill_in_lock_file_name (char *lockfile, Lisp_Object fn)
323 char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn));
324 char *base = last_slash + 1;
325 ptrdiff_t dirlen = base - SSDATA (fn);
326 memcpy (lockfile, SSDATA (fn), dirlen);
327 lockfile[dirlen] = '.';
328 lockfile[dirlen + 1] = '#';
329 strcpy (lockfile + dirlen + 2, base);
332 /* For some reason Linux kernels return EPERM on file systems that do
333 not support hard or symbolic links. This symbol documents the quirk.
334 There is no way to tell whether a symlink call fails due to
335 permissions issues or because links are not supported, but luckily
336 the lock file code should work either way. */
337 enum { LINKS_MIGHT_NOT_WORK = EPERM };
339 /* Rename OLD to NEW. If FORCE, replace any existing NEW.
340 It is OK if there are temporarily two hard links to OLD.
341 Return 0 if successful, -1 (setting errno) otherwise. */
342 static int
343 rename_lock_file (char const *old, char const *new, bool force)
345 #ifdef WINDOWSNT
346 return sys_rename_replace (old, new, force);
347 #else
348 if (! force)
350 struct stat st;
352 if (link (old, new) == 0)
353 return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
354 if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)
355 return -1;
357 /* 'link' does not work on this file system. This can occur on
358 a GNU/Linux host mounting a FAT32 file system. Fall back on
359 'rename' after checking that NEW does not exist. There is a
360 potential race condition since some other process may create
361 NEW immediately after the existence check, but it's the best
362 we can portably do here. */
363 if (lstat (new, &st) == 0 || errno == EOVERFLOW)
365 errno = EEXIST;
366 return -1;
368 if (errno != ENOENT)
369 return -1;
372 return rename (old, new);
373 #endif
376 /* Create the lock file LFNAME with contents LOCK_INFO_STR. Return 0 if
377 successful, an errno value on failure. If FORCE, remove any
378 existing LFNAME if necessary. */
380 static int
381 create_lock_file (char *lfname, char *lock_info_str, bool force)
383 #ifdef WINDOWSNT
384 /* Symlinks are supported only by later versions of Windows, and
385 creating them is a privileged operation that often triggers
386 User Account Control elevation prompts. Avoid the problem by
387 pretending that 'symlink' does not work. */
388 int err = ENOSYS;
389 #else
390 int err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
391 #endif
393 if (err == EEXIST && force)
395 unlink (lfname);
396 err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
399 if (err == ENOSYS || err == LINKS_MIGHT_NOT_WORK || err == ENAMETOOLONG)
401 static char const nonce_base[] = ".#-emacsXXXXXX";
402 char *last_slash = strrchr (lfname, '/');
403 ptrdiff_t lfdirlen = last_slash + 1 - lfname;
404 USE_SAFE_ALLOCA;
405 char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base);
406 int fd;
407 memcpy (nonce, lfname, lfdirlen);
408 strcpy (nonce + lfdirlen, nonce_base);
410 fd = mkostemp (nonce, O_BINARY | O_CLOEXEC);
411 if (fd < 0)
412 err = errno;
413 else
415 ptrdiff_t lock_info_len;
416 if (! O_CLOEXEC)
417 fcntl (fd, F_SETFD, FD_CLOEXEC);
418 lock_info_len = strlen (lock_info_str);
419 err = 0;
420 /* Use 'write', not 'emacs_write', as garbage collection
421 might signal an error, which would leak FD. */
422 if (write (fd, lock_info_str, lock_info_len) != lock_info_len
423 || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
424 err = errno;
425 /* There is no need to call fsync here, as the contents of
426 the lock file need not survive system crashes. */
427 if (emacs_close (fd) != 0)
428 err = errno;
429 if (!err && rename_lock_file (nonce, lfname, force) != 0)
430 err = errno;
431 if (err)
432 unlink (nonce);
435 SAFE_FREE ();
438 return err;
441 /* Lock the lock file named LFNAME.
442 If FORCE, do so even if it is already locked.
443 Return 0 if successful, an error number on failure. */
445 static int
446 lock_file_1 (char *lfname, bool force)
448 /* Call this first because it can GC. */
449 printmax_t boot = get_boot_time ();
451 Lisp_Object luser_name = Fuser_login_name (Qnil);
452 char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
453 Lisp_Object lhost_name = Fsystem_name ();
454 char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : "";
455 char lock_info_str[MAX_LFINFO + 1];
456 printmax_t pid = getpid ();
458 if (boot)
460 if (sizeof lock_info_str
461 <= snprintf (lock_info_str, sizeof lock_info_str,
462 "%s@%s.%"pMd":%"pMd,
463 user_name, host_name, pid, boot))
464 return ENAMETOOLONG;
466 else if (sizeof lock_info_str
467 <= snprintf (lock_info_str, sizeof lock_info_str,
468 "%s@%s.%"pMd,
469 user_name, host_name, pid))
470 return ENAMETOOLONG;
472 return create_lock_file (lfname, lock_info_str, force);
475 /* Return true if times A and B are no more than one second apart. */
477 static bool
478 within_one_second (time_t a, time_t b)
480 return (a - b >= -1 && a - b <= 1);
483 /* On systems lacking ELOOP, test for an errno value that shouldn't occur. */
484 #ifndef ELOOP
485 # define ELOOP (-1)
486 #endif
488 /* Read the data for the lock file LFNAME into LFINFO. Read at most
489 MAX_LFINFO + 1 bytes. Return the number of bytes read, or -1
490 (setting errno) on error. */
492 static ptrdiff_t
493 read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
495 ptrdiff_t nbytes;
497 while ((nbytes = readlinkat (AT_FDCWD, lfname, lfinfo, MAX_LFINFO + 1)) < 0
498 && errno == EINVAL)
500 int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0);
501 if (0 <= fd)
503 /* Use read, not emacs_read, since FD isn't unwind-protected. */
504 ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
505 int read_errno = errno;
506 if (emacs_close (fd) != 0)
507 return -1;
508 errno = read_errno;
509 return read_bytes;
512 if (errno != ELOOP)
513 return -1;
515 /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
516 The former must have been removed and replaced by the latter.
517 Try again. */
518 QUIT;
521 return nbytes;
524 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
525 1 if another process owns it (and set OWNER (if non-null) to info),
526 2 if the current process owns it,
527 or -1 if something is wrong with the locking mechanism. */
529 static int
530 current_lock_owner (lock_info_type *owner, char *lfname)
532 int ret;
533 lock_info_type local_owner;
534 ptrdiff_t lfinfolen;
535 intmax_t pid, boot_time;
536 char *at, *dot, *lfinfo_end;
538 /* Even if the caller doesn't want the owner info, we still have to
539 read it to determine return value. */
540 if (!owner)
541 owner = &local_owner;
543 /* If nonexistent lock file, all is well; otherwise, got strange error. */
544 lfinfolen = read_lock_data (lfname, owner->user);
545 if (lfinfolen < 0)
546 return errno == ENOENT ? 0 : -1;
547 if (MAX_LFINFO < lfinfolen)
548 return -1;
549 owner->user[lfinfolen] = 0;
551 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
552 /* The USER is everything before the last @. */
553 owner->at = at = memrchr (owner->user, '@', lfinfolen);
554 if (!at)
555 return -1;
556 owner->dot = dot = strrchr (at, '.');
557 if (!dot)
558 return -1;
560 /* The PID is everything from the last `.' to the `:'. */
561 if (! c_isdigit (dot[1]))
562 return -1;
563 errno = 0;
564 pid = strtoimax (dot + 1, &owner->colon, 10);
565 if (errno == ERANGE)
566 pid = -1;
568 /* After the `:', if there is one, comes the boot time. */
569 switch (owner->colon[0])
571 case 0:
572 boot_time = 0;
573 lfinfo_end = owner->colon;
574 break;
576 case ':':
577 if (! c_isdigit (owner->colon[1]))
578 return -1;
579 boot_time = strtoimax (owner->colon + 1, &lfinfo_end, 10);
580 break;
582 default:
583 return -1;
585 if (lfinfo_end != owner->user + lfinfolen)
586 return -1;
588 /* On current host? */
589 Lisp_Object system_name = Fsystem_name ();
590 if (STRINGP (system_name)
591 && dot - (at + 1) == SBYTES (system_name)
592 && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0)
594 if (pid == getpid ())
595 ret = 2; /* We own it. */
596 else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t)
597 && (kill (pid, 0) >= 0 || errno == EPERM)
598 && (boot_time == 0
599 || (boot_time <= TYPE_MAXIMUM (time_t)
600 && within_one_second (boot_time, get_boot_time ()))))
601 ret = 1; /* An existing process on this machine owns it. */
602 /* The owner process is dead or has a strange pid, so try to
603 zap the lockfile. */
604 else
605 return unlink (lfname);
607 else
608 { /* If we wanted to support the check for stale locks on remote machines,
609 here's where we'd do it. */
610 ret = 1;
613 return ret;
617 /* Lock the lock named LFNAME if possible.
618 Return 0 in that case.
619 Return positive if some other process owns the lock, and info about
620 that process in CLASHER.
621 Return -1 if cannot lock for any other reason. */
623 static int
624 lock_if_free (lock_info_type *clasher, char *lfname)
626 int err;
627 while ((err = lock_file_1 (lfname, 0)) == EEXIST)
629 switch (current_lock_owner (clasher, lfname))
631 case 2:
632 return 0; /* We ourselves locked it. */
633 case 1:
634 return 1; /* Someone else has it. */
635 case -1:
636 return -1; /* current_lock_owner returned strange error. */
639 /* We deleted a stale lock; try again to lock the file. */
642 return err ? -1 : 0;
645 /* lock_file locks file FN,
646 meaning it serves notice on the world that you intend to edit that file.
647 This should be done only when about to modify a file-visiting
648 buffer previously unmodified.
649 Do not (normally) call this for a buffer already modified,
650 as either the file is already locked, or the user has already
651 decided to go ahead without locking.
653 When this returns, either the lock is locked for us,
654 or lock creation failed,
655 or the user has said to go ahead without locking.
657 If the file is locked by someone else, this calls
658 ask-user-about-lock (a Lisp function) with two arguments,
659 the file name and info about the user who did the locking.
660 This function can signal an error, or return t meaning
661 take away the lock, or return nil meaning ignore the lock. */
663 void
664 lock_file (Lisp_Object fn)
666 Lisp_Object orig_fn, encoded_fn;
667 char *lfname;
668 lock_info_type lock_info;
669 struct gcpro gcpro1;
670 USE_SAFE_ALLOCA;
672 /* Don't do locking while dumping Emacs.
673 Uncompressing wtmp files uses call-process, which does not work
674 in an uninitialized Emacs. */
675 if (! NILP (Vpurify_flag))
676 return;
678 orig_fn = fn;
679 GCPRO1 (fn);
680 fn = Fexpand_file_name (fn, Qnil);
681 #ifdef WINDOWSNT
682 /* Ensure we have only '/' separators, to avoid problems with
683 looking (inside fill_in_lock_file_name) for backslashes in file
684 names encoded by some DBCS codepage. */
685 dostounix_filename (SSDATA (fn));
686 #endif
687 encoded_fn = ENCODE_FILE (fn);
689 /* See if this file is visited and has changed on disk since it was
690 visited. */
692 register Lisp_Object subject_buf;
694 subject_buf = get_truename_buffer (orig_fn);
696 if (!NILP (subject_buf)
697 && NILP (Fverify_visited_file_modtime (subject_buf))
698 && !NILP (Ffile_exists_p (fn)))
699 call1 (intern ("ask-user-about-supersession-threat"), fn);
703 /* Don't do locking if the user has opted out. */
704 if (create_lockfiles)
707 /* Create the name of the lock-file for file fn */
708 MAKE_LOCK_NAME (lfname, encoded_fn);
710 /* Try to lock the lock. */
711 if (0 < lock_if_free (&lock_info, lfname))
713 /* Someone else has the lock. Consider breaking it. */
714 Lisp_Object attack;
715 char *dot = lock_info.dot;
716 ptrdiff_t pidlen = lock_info.colon - (dot + 1);
717 static char const replacement[] = " (pid ";
718 int replacementlen = sizeof replacement - 1;
719 memmove (dot + replacementlen, dot + 1, pidlen);
720 strcpy (dot + replacementlen + pidlen, ")");
721 memcpy (dot, replacement, replacementlen);
722 attack = call2 (intern ("ask-user-about-lock"), fn,
723 build_string (lock_info.user));
724 /* Take the lock if the user said so. */
725 if (!NILP (attack))
726 lock_file_1 (lfname, 1);
728 SAFE_FREE ();
731 UNGCPRO;
734 void
735 unlock_file (Lisp_Object fn)
737 char *lfname;
738 USE_SAFE_ALLOCA;
740 fn = Fexpand_file_name (fn, Qnil);
741 fn = ENCODE_FILE (fn);
743 MAKE_LOCK_NAME (lfname, fn);
745 if (current_lock_owner (0, lfname) == 2)
746 unlink (lfname);
748 SAFE_FREE ();
751 void
752 unlock_all_files (void)
754 register Lisp_Object tail, buf;
755 register struct buffer *b;
757 FOR_EACH_LIVE_BUFFER (tail, buf)
759 b = XBUFFER (buf);
760 if (STRINGP (BVAR (b, file_truename))
761 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
762 unlock_file (BVAR (b, file_truename));
766 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
767 0, 1, 0,
768 doc: /* Lock FILE, if current buffer is modified.
769 FILE defaults to current buffer's visited file,
770 or else nothing is done if current buffer isn't visiting a file.
772 If the option `create-lockfiles' is nil, this does nothing. */)
773 (Lisp_Object file)
775 if (NILP (file))
776 file = BVAR (current_buffer, file_truename);
777 else
778 CHECK_STRING (file);
779 if (SAVE_MODIFF < MODIFF
780 && !NILP (file))
781 lock_file (file);
782 return Qnil;
785 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
786 0, 0, 0,
787 doc: /* Unlock the file visited in the current buffer.
788 If the buffer is not modified, this does nothing because the file
789 should not be locked in that case. */)
790 (void)
792 if (SAVE_MODIFF < MODIFF
793 && STRINGP (BVAR (current_buffer, file_truename)))
794 unlock_file (BVAR (current_buffer, file_truename));
795 return Qnil;
798 /* Unlock the file visited in buffer BUFFER. */
800 void
801 unlock_buffer (struct buffer *buffer)
803 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
804 && STRINGP (BVAR (buffer, file_truename)))
805 unlock_file (BVAR (buffer, file_truename));
808 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
809 doc: /* Return a value indicating whether FILENAME is locked.
810 The value is nil if the FILENAME is not locked,
811 t if it is locked by you, else a string saying which user has locked it. */)
812 (Lisp_Object filename)
814 Lisp_Object ret;
815 char *lfname;
816 int owner;
817 lock_info_type locker;
818 USE_SAFE_ALLOCA;
820 filename = Fexpand_file_name (filename, Qnil);
822 MAKE_LOCK_NAME (lfname, filename);
824 owner = current_lock_owner (&locker, lfname);
825 if (owner <= 0)
826 ret = Qnil;
827 else if (owner == 2)
828 ret = Qt;
829 else
830 ret = make_string (locker.user, locker.at - locker.user);
832 SAFE_FREE ();
833 return ret;
836 void
837 syms_of_filelock (void)
839 DEFVAR_LISP ("temporary-file-directory", Vtemporary_file_directory,
840 doc: /* The directory for writing temporary files. */);
841 Vtemporary_file_directory = Qnil;
843 DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
844 doc: /* Non-nil means use lockfiles to avoid editing collisions. */);
845 create_lockfiles = 1;
847 defsubr (&Sunlock_buffer);
848 defsubr (&Slock_buffer);
849 defsubr (&Sfile_locked_p);