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