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