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