1 /* Lock files for editing.
2
3 Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2023 Free Software
4 Foundation, Inc.
5
6 Author: Richard King
7 (according to authors.el)
8
9 This file is part of GNU Emacs.
10
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 (at
14 your option) any later version.
15
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.
20
21 You should have received a copy of the GNU General Public License
22 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
23
24
25 #include <config.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
28 #include <signal.h>
29 #include <stdio.h>
30 #include <stdlib.h>
31
32 #ifdef HAVE_PWD_H
33 #include <pwd.h>
34 #endif
35
36 #include <sys/file.h>
37 #include <fcntl.h>
38 #include <unistd.h>
39
40 #ifdef __FreeBSD__
41 #include <sys/sysctl.h>
42 #endif /* __FreeBSD__ */
43
44 #include <errno.h>
45
46 #include <c-ctype.h>
47
48 #include "lisp.h"
49 #include "buffer.h"
50 #include "coding.h"
51 #ifdef WINDOWSNT
52 #include <share.h>
53 #include <sys/socket.h> /* for fcntl */
54 #endif
55
56 #ifndef MSDOS
57
58 #ifdef HAVE_UTMP_H
59 #include <utmp.h>
60 #endif
61
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
67
68 #if !defined WTMP_FILE && !defined WINDOWSNT && defined BOOT_TIME
69 #define WTMP_FILE "/var/log/wtmp"
70 #endif
71
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:BOOT. This avoids a single
75 mount (== failure) point for lock files. The :BOOT is omitted if
76 the boot time is not available.
77
78 When the host in the lock data is the current host, we can check if
79 the pid is valid with kill.
80
81 Otherwise, we could look at a separate file that maps hostnames to
82 reboot times to see if the remote pid can possibly be valid, since we
83 don't want Emacs to have to communicate via pipes or sockets or
84 whatever to other processes, either locally or remotely; rms says
85 that's too unreliable. Hence the separate file, which could
86 theoretically be updated by daemons running separately -- but this
87 whole idea is unimplemented; in practice, at least in our
88 environment, it seems such stale locks arise fairly infrequently, and
89 Emacs' standard methods of dealing with clashes suffice.
90
91 We use symlinks instead of normal files because (1) they can be
92 stored more efficiently on the filesystem, since the kernel knows
93 they will be small, and (2) all the info about the lock can be read
94 in a single system call (readlink). Although we could use regular
95 files to be useful on old systems lacking symlinks, nowadays
96 virtually all such systems are probably single-user anyway, so it
97 didn't seem worth the complication.
98
99 Similarly, we don't worry about a possible 14-character limit on
100 file names, because those are all the same systems that don't have
101 symlinks.
102
103 This is compatible with the locking scheme used by Interleaf (which
104 has contributed this implementation for Emacs), and was designed by
105 Karl Berry, Ethan Jacobson, Kimbo Mundy, and others.
106
107 On some file systems, notably those of MS-Windows, symbolic links
108 do not work well, so instead of a symlink .#FN -> USER@HOST.PID:BOOT,
109 the lock is a regular file .#FN with contents USER@HOST.PID:BOOT. To
110 establish a lock, a nonce file is created and then renamed to .#FN.
111 On MS-Windows this renaming is atomic unless the lock is forcibly
112 acquired. On other systems the renaming is atomic if the lock is
113 forcibly acquired; if not, the renaming is done via hard links,
114 which is good enough for lock-file purposes.
115
116 To summarize, race conditions can occur with either:
117
118 * Forced locks on MS-Windows systems.
119
120 * Non-forced locks on non-MS-Windows systems that support neither
121 hard nor symbolic links. */
122
123
124 /* Return the time of the last system boot. */
125
126 static time_t boot_time;
127 static bool boot_time_initialized;
128
129 #ifdef BOOT_TIME
130 static void get_boot_time_1 (const char *, bool);
131 #endif
132
133 static time_t
134 get_boot_time (void)
135 {
136 #if defined (BOOT_TIME)
137 int counter;
138 #endif
139
140 if (boot_time_initialized)
141 return boot_time;
142 boot_time_initialized = 1;
143
144 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
145 {
146 int mib[2];
147 size_t size;
148 struct timeval boottime_val;
149
150 mib[0] = CTL_KERN;
151 mib[1] = KERN_BOOTTIME;
152 size = sizeof (boottime_val);
153
154 if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0 && size != 0)
155 {
156 boot_time = boottime_val.tv_sec;
157 return boot_time;
158 }
159 }
160 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
161
162 if (BOOT_TIME_FILE)
163 {
164 struct stat st;
165 if (stat (BOOT_TIME_FILE, &st) == 0)
166 {
167 boot_time = st.st_mtime;
168 return boot_time;
169 }
170 }
171
172 #if defined (BOOT_TIME)
173 /* The utmp routines maintain static state. Don't touch that state
174 if we are going to dump, since it might not survive dumping. */
175 if (will_dump_p ())
176 return boot_time;
177
178 /* Try to get boot time from utmp before wtmp,
179 since utmp is typically much smaller than wtmp.
180 Passing a null pointer causes get_boot_time_1
181 to inspect the default file, namely utmp. */
182 get_boot_time_1 (0, 0);
183 if (boot_time)
184 return boot_time;
185
186 /* Try to get boot time from the current wtmp file. */
187 get_boot_time_1 (WTMP_FILE, 1);
188
189 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
190 for (counter = 0; counter < 20 && ! boot_time; counter++)
191 {
192 Lisp_Object filename = Qnil;
193 bool delete_flag = false;
194 char cmd_string[sizeof WTMP_FILE ".19.gz"];
195 AUTO_STRING_WITH_LEN (tempname, cmd_string,
196 sprintf (cmd_string, "%s.%d", WTMP_FILE, counter));
197 if (! NILP (Ffile_exists_p (tempname)))
198 filename = tempname;
199 else
200 {
201 tempname = make_formatted_string (cmd_string, "%s.%d.gz",
202 WTMP_FILE, counter);
203 if (! NILP (Ffile_exists_p (tempname)))
204 {
205 /* The utmp functions on older systems accept only file
206 names up to 8 bytes long. Choose a 2 byte prefix, so
207 the 6-byte suffix does not make the name too long. */
208 filename = Fmake_temp_file_internal (build_string ("wt"), Qnil,
209 empty_unibyte_string, Qnil);
210 CALLN (Fcall_process, build_string ("gzip"), Qnil,
211 list2 (QCfile, filename), Qnil,
212 build_string ("-cd"), tempname);
213 delete_flag = true;
214 }
215 }
216
217 if (! NILP (filename))
218 {
219 get_boot_time_1 (SSDATA (filename), 1);
220 if (delete_flag)
221 unlink (SSDATA (filename));
222 }
223 }
224
225 return boot_time;
226 #else
227 return 0;
228 #endif
229 }
230
231 #ifdef BOOT_TIME
232 /* Try to get the boot time from wtmp file FILENAME.
233 This succeeds if that file contains a reboot record.
234
235 If FILENAME is zero, use the same file as before;
236 if no FILENAME has ever been specified, this is the utmp file.
237 Use the newest reboot record if NEWEST,
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
242 void
243 get_boot_time_1 (const char *filename, bool newest)
244 {
245 struct utmp ut, *utp;
246
247 if (filename)
248 utmpname (filename);
249
250 setutent ();
251
252 while (1)
253 {
254 /* Find the next reboot record. */
255 ut.ut_type = BOOT_TIME;
256 utp = getutid (&ut);
257 if (! utp)
258 break;
259 /* Compare reboot times and use the newest one. */
260 if (utp->ut_time > boot_time)
261 {
262 boot_time = utp->ut_time;
263 if (! newest)
264 break;
265 }
266 /* Advance on element in the file
267 so that getutid won't repeat the same one. */
268 utp = getutent ();
269 if (! utp)
270 break;
271 }
272 endutent ();
273 }
274 #endif /* BOOT_TIME */
275
276 /* An arbitrary limit on lock contents length. 8 K should be plenty
277 big enough in practice. */
278 enum { MAX_LFINFO = 8 * 1024 };
279
280 /* Here is the structure that stores information about a lock. */
281
282 typedef struct
283 {
284 /* Location of '@', '.', and ':' (or equivalent) in USER. If there's
285 no colon or equivalent, COLON points to the end of USER. */
286 char *at, *dot, *colon;
287
288 /* Lock file contents USER@HOST.PID with an optional :BOOT_TIME
289 appended. This memory is used as a lock file contents buffer, so
290 it needs room for MAX_LFINFO + 1 bytes. A string " (pid NNNN)"
291 may be appended to the USER@HOST while generating a diagnostic,
292 so make room for its extra bytes (as opposed to ".NNNN") too. */
293 char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
294 } lock_info_type;
295
296 /* For some reason Linux kernels return EPERM on file systems that do
297 not support hard or symbolic links. This symbol documents the quirk.
298 There is no way to tell whether a symlink call fails due to
299 permissions issues or because links are not supported, but luckily
300 the lock file code should work either way. */
301 enum { LINKS_MIGHT_NOT_WORK = EPERM };
302
303 /* Rename OLD to NEW. If FORCE, replace any existing NEW.
304 It is OK if there are temporarily two hard links to OLD.
305 Return 0 if successful, -1 (setting errno) otherwise. */
306 static int
307 rename_lock_file (char const *old, char const *new, bool force)
308 {
309 #ifdef WINDOWSNT
310 return sys_rename_replace (old, new, force);
311 #else
312 if (! force)
313 {
314 struct stat st;
315
316 int r = renameat_noreplace (AT_FDCWD, old, AT_FDCWD, new);
317 if (! (r < 0 && errno == ENOSYS))
318 return r;
319 if (link (old, new) == 0)
320 return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
321 if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)
322 return -1;
323
324 /* 'link' does not work on this file system. This can occur on
325 a GNU/Linux host mounting a FAT32 file system. Fall back on
326 'rename' after checking that NEW does not exist. There is a
327 potential race condition since some other process may create
328 NEW immediately after the existence check, but it's the best
329 we can portably do here. */
330 if (emacs_fstatat (AT_FDCWD, new, &st, AT_SYMLINK_NOFOLLOW) == 0
331 || errno == EOVERFLOW)
332 {
333 errno = EEXIST;
334 return -1;
335 }
336 if (errno != ENOENT)
337 return -1;
338 }
339
340 return rename (old, new);
341 #endif
342 }
343
344 /* Create the lock file LFNAME with contents LOCK_INFO_STR. Return 0 if
345 successful, an errno value on failure. If FORCE, remove any
346 existing LFNAME if necessary. */
347
348 static int
349 create_lock_file (char *lfname, char *lock_info_str, bool force)
350 {
351 #ifdef WINDOWSNT
352 /* Symlinks are supported only by later versions of Windows, and
353 creating them is a privileged operation that often triggers
354 User Account Control elevation prompts. Avoid the problem by
355 pretending that 'symlink' does not work. */
356 int err = ENOSYS;
357 #else
358 int err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
359 #endif
360
361 if (err == EEXIST && force)
362 {
363 unlink (lfname);
364 err = symlink (lock_info_str, lfname) == 0 ? 0 : errno;
365 }
366
367 if (err == ENOSYS || err == LINKS_MIGHT_NOT_WORK || err == ENAMETOOLONG)
368 {
369 static char const nonce_base[] = ".#-emacsXXXXXX";
370 char *last_slash = strrchr (lfname, '/');
371 ptrdiff_t lfdirlen = last_slash + 1 - lfname;
372 USE_SAFE_ALLOCA;
373 char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base);
374 int fd;
375 memcpy (nonce, lfname, lfdirlen);
376 strcpy (nonce + lfdirlen, nonce_base);
377
378 fd = mkostemp (nonce, O_BINARY | O_CLOEXEC);
379 if (fd < 0)
380 err = errno;
381 else
382 {
383 ptrdiff_t lock_info_len;
384 lock_info_len = strlen (lock_info_str);
385 err = 0;
386
387 /* Make the lock file readable to others, so that others' sessions
388 can read it. Even though nobody should write to the lock file,
389 keep it user-writable to work around problems on nonstandard file
390 systems that prohibit unlinking readonly files (Bug#37884). */
391 if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
392 || fchmod (fd, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH) != 0)
393 err = errno;
394
395 /* There is no need to call fsync here, as the contents of
396 the lock file need not survive system crashes. */
397 if (emacs_close (fd) != 0)
398 err = errno;
399 if (!err && rename_lock_file (nonce, lfname, force) != 0)
400 err = errno;
401 if (err)
402 unlink (nonce);
403 }
404
405 SAFE_FREE ();
406 }
407
408 return err;
409 }
410
411 /* Lock the lock file named LFNAME.
412 If FORCE, do so even if it is already locked.
413 Return 0 if successful, an error number on failure. */
414
415 static int
416 lock_file_1 (Lisp_Object lfname, bool force)
417 {
418 intmax_t boot = get_boot_time ();
419 Lisp_Object luser_name = Fuser_login_name (Qnil);
420 Lisp_Object lhost_name = Fsystem_name ();
421
422 /* Protect against the extremely unlikely case of the host name
423 containing an @ character. */
424 if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@'))
425 lhost_name = CALLN (Ffuncall, intern ("string-replace"),
426 build_string ("@"), build_string ("-"),
427 lhost_name);
428
429 char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
430 char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : "";
431 char lock_info_str[MAX_LFINFO + 1];
432 intmax_t pid = getpid ();
433
434 if (boot)
435 {
436 if (sizeof lock_info_str
437 <= snprintf (lock_info_str, sizeof lock_info_str,
438 "%s@%s.%"PRIdMAX":%"PRIdMAX,
439 user_name, host_name, pid, boot))
440 return ENAMETOOLONG;
441 }
442 else if (sizeof lock_info_str
443 <= snprintf (lock_info_str, sizeof lock_info_str,
444 "%s@%s.%"PRIdMAX,
445 user_name, host_name, pid))
446 return ENAMETOOLONG;
447
448 return create_lock_file (SSDATA (lfname), lock_info_str, force);
449 }
450
451 /* Return true if times A and B are no more than one second apart. */
452
453 static bool
454 within_one_second (time_t a, time_t b)
455 {
456 return (a - b >= -1 && a - b <= 1);
457 }
458
459 /* On systems lacking ELOOP, test for an errno value that shouldn't occur. */
460 #ifndef ELOOP
461 # define ELOOP (-1)
462 #endif
463
464 /* Read the data for the lock file LFNAME into LFINFO. Read at most
465 MAX_LFINFO + 1 bytes. Return the number of bytes read, or -1
466 (setting errno) on error. */
467
468 static ptrdiff_t
469 read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
470 {
471 ptrdiff_t nbytes;
472
473 while ((nbytes = readlinkat (AT_FDCWD, lfname, lfinfo, MAX_LFINFO + 1)) < 0
474 && errno == EINVAL)
475 {
476 int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
477 if (0 <= fd)
478 {
479 ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
480 int read_errno = errno;
481 if (emacs_close (fd) != 0)
482 return -1;
483 errno = read_errno;
484 return read_bytes;
485 }
486
487 if (errno != ELOOP)
488 return -1;
489
490 /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
491 The former must have been removed and replaced by the latter.
492 Try again. */
493 maybe_quit ();
494 }
495
496 return nbytes;
497 }
498
499 /* True if errno values are negative. Although the C standard
500 requires them to be positive, they are negative in Haiku. */
501 enum { NEGATIVE_ERRNO = EDOM < 0 };
502
503 /* Nonzero values that are not errno values. */
504 enum
505 {
506 /* Another process on this machine owns it. */
507 ANOTHER_OWNS_IT = NEGATIVE_ERRNO ? 1 : -1,
508
509 /* This Emacs process owns it. */
510 I_OWN_IT = 2 * ANOTHER_OWNS_IT
511 };
512
513 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
514 ANOTHER_OWNS_IT if another process owns it
515 (and set OWNER (if non-null) to info),
516 I_OWN_IT if the current process owns it,
517 or an errno value if something is wrong with the locking mechanism. */
518
519 static int
520 current_lock_owner (lock_info_type *owner, Lisp_Object lfname)
521 {
522 lock_info_type local_owner;
523 ptrdiff_t lfinfolen;
524 intmax_t pid, boot_time;
525 char *at, *dot, *lfinfo_end;
526
527 /* Even if the caller doesn't want the owner info, we still have to
528 read it to determine return value. */
529 if (!owner)
530 owner = &local_owner;
531
532 /* If nonexistent lock file, all is well; otherwise, got strange error. */
533 lfinfolen = read_lock_data (SSDATA (lfname), owner->user);
534 if (lfinfolen < 0)
535 return errno == ENOENT || errno == ENOTDIR ? 0 : errno;
536 if (MAX_LFINFO < lfinfolen)
537 return ENAMETOOLONG;
538 owner->user[lfinfolen] = 0;
539
540 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return EINVAL. */
541 /* The USER is everything before the last @. */
542 owner->at = at = memrchr (owner->user, '@', lfinfolen);
543 if (!at)
544 return EINVAL;
545 owner->dot = dot = strrchr (at, '.');
546 if (!dot)
547 return EINVAL;
548
549 /* The PID is everything from the last '.' to the ':' or equivalent. */
550 if (! c_isdigit (dot[1]))
551 return EINVAL;
552 errno = 0;
553 pid = strtoimax (dot + 1, &owner->colon, 10);
554 if (errno == ERANGE)
555 pid = -1;
556
557 /* After the ':' or equivalent, if there is one, comes the boot time. */
558 char *boot = owner->colon + 1;
559 switch (owner->colon[0])
560 {
561 case 0:
562 boot_time = 0;
563 lfinfo_end = owner->colon;
564 break;
565
566 case '\357':
567 /* Treat "\357\200\242" (U+F022 in UTF-8) as if it were ":" (Bug#24656).
568 This works around a bug in the Linux CIFS kernel client, which can
569 mistakenly transliterate ':' to U+F022 in symlink contents.
570 See <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>. */
571 if (! (boot[0] == '\200' && boot[1] == '\242'))
572 return EINVAL;
573 boot += 2;
574 FALLTHROUGH;
575 case ':':
576 if (! c_isdigit (boot[0]))
577 return EINVAL;
578 boot_time = strtoimax (boot, &lfinfo_end, 10);
579 break;
580
581 default:
582 return EINVAL;
583 }
584 if (lfinfo_end != owner->user + lfinfolen)
585 return EINVAL;
586
587 Lisp_Object system_name = Fsystem_name ();
588 /* If `system-name' returns nil, that means we're in a
589 --no-build-details Emacs, and the name part of the link (e.g.,
590 .#test.txt -> larsi@.118961:1646577954) is an empty string. */
591 if (NILP (system_name))
592 system_name = build_string ("");
593 /* Protect against the extremely unlikely case of the host name
594 containing an @ character. */
595 else if (strchr (SSDATA (system_name), '@'))
596 system_name = CALLN (Ffuncall, intern ("string-replace"),
597 build_string ("@"), build_string ("-"),
598 system_name);
599 /* On current host? */
600 if (STRINGP (system_name)
601 && dot - (at + 1) == SBYTES (system_name)
602 && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0)
603 {
604 if (pid == getpid ())
605 return I_OWN_IT;
606 else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t)
607 && (kill (pid, 0) >= 0 || errno == EPERM)
608 && (boot_time == 0
609 || (boot_time <= TYPE_MAXIMUM (time_t)
610 && within_one_second (boot_time, get_boot_time ()))))
611 return ANOTHER_OWNS_IT;
612 /* The owner process is dead or has a strange pid, so try to
613 zap the lockfile. */
614 else
615 return unlink (SSDATA (lfname)) < 0 ? errno : 0;
616 }
617 else
618 { /* If we wanted to support the check for stale locks on remote machines,
619 here's where we'd do it. */
620 return ANOTHER_OWNS_IT;
621 }
622 }
623
624
625 /* Lock the lock named LFNAME if possible.
626 Return 0 in that case.
627 Return ANOTHER_OWNS_IT if some other process owns the lock, and info about
628 that process in CLASHER.
629 Return errno value if cannot lock for any other reason. */
630
631 static int
632 lock_if_free (lock_info_type *clasher, Lisp_Object lfname)
633 {
634 int err;
635 while ((err = lock_file_1 (lfname, 0)) == EEXIST)
636 {
637 err = current_lock_owner (clasher, lfname);
638
639 /* Return if we locked it, or another process owns it, or it is
640 a strange error. */
641 if (err != 0)
642 return err == I_OWN_IT ? 0 : err;
643
644 /* We deleted a stale lock or some other process deleted the lock;
645 try again to lock the file. */
646 }
647
648 return err;
649 }
650
651 /* Return the encoded name of the lock file for FN, or nil if none. */
652
653 static Lisp_Object
654 make_lock_file_name (Lisp_Object fn)
655 {
656 Lisp_Object lock_file_name = call1 (Qmake_lock_file_name,
657 Fexpand_file_name (fn, Qnil));
658 return !NILP (lock_file_name) ? ENCODE_FILE (lock_file_name) : Qnil;
659 }
660
661 /* lock_file locks file FN,
662 meaning it serves notice on the world that you intend to edit that file.
663 This should be done only when about to modify a file-visiting
664 buffer previously unmodified.
665 Do not (normally) call this for a buffer already modified,
666 as either the file is already locked, or the user has already
667 decided to go ahead without locking.
668
669 When this returns, either the lock is locked for us,
670 or lock creation failed,
671 or the user has said to go ahead without locking.
672
673 If the file is locked by someone else, this calls
674 ask-user-about-lock (a Lisp function) with two arguments,
675 the file name and info about the user who did the locking.
676 This function can signal an error, or return t meaning
677 take away the lock, or return nil meaning ignore the lock. */
678
679 static Lisp_Object
680 lock_file (Lisp_Object fn)
681 {
682 lock_info_type lock_info;
683
684 /* Don't do locking while dumping Emacs.
685 Uncompressing wtmp files uses call-process, which does not work
686 in an uninitialized Emacs. */
687 if (will_dump_p ())
688 return Qnil;
689
690 Lisp_Object lfname = Qnil;
691 if (create_lockfiles)
692 {
693 /* Create the name of the lock-file for file fn */
694 lfname = make_lock_file_name (fn);
695 if (NILP (lfname))
696 return Qnil;
697 }
698
699 /* See if this file is visited and has changed on disk since it was
700 visited. */
701 Lisp_Object subject_buf = get_truename_buffer (fn);
702 if (!NILP (subject_buf)
703 && NILP (Fverify_visited_file_modtime (subject_buf))
704 && !NILP (Ffile_exists_p (fn))
705 && !(!NILP (lfname) && current_lock_owner (NULL, lfname) == I_OWN_IT))
706 call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
707
708 /* Don't do locking if the user has opted out. */
709 if (!NILP (lfname))
710 {
711 /* Try to lock the lock. FIXME: This ignores errors when
712 lock_if_free returns an errno value. */
713 if (lock_if_free (&lock_info, lfname) == ANOTHER_OWNS_IT)
714 {
715 /* Someone else has the lock. Consider breaking it. */
716 Lisp_Object attack;
717 char *dot = lock_info.dot;
718 ptrdiff_t pidlen = lock_info.colon - (dot + 1);
719 static char const replacement[] = " (pid ";
720 int replacementlen = sizeof replacement - 1;
721 memmove (dot + replacementlen, dot + 1, pidlen);
722 strcpy (dot + replacementlen + pidlen, ")");
723 memcpy (dot, replacement, replacementlen);
724 attack = call2 (intern ("ask-user-about-lock"), fn,
725 build_string (lock_info.user));
726 /* Take the lock if the user said so. */
727 if (!NILP (attack))
728 lock_file_1 (lfname, 1);
729 }
730 }
731 return Qnil;
732 }
733
734 static Lisp_Object
735 unlock_file (Lisp_Object fn)
736 {
737 Lisp_Object lfname = make_lock_file_name (fn);
738 if (NILP (lfname))
739 return Qnil;
740
741 int err = current_lock_owner (0, lfname);
742 if (! (err == 0 || err == ANOTHER_OWNS_IT
743 || (err == I_OWN_IT
744 && (unlink (SSDATA (lfname)) == 0 || (err = errno) == ENOENT))))
745 report_file_errno ("Unlocking file", fn, err);
746
747 return Qnil;
748 }
749
750 static Lisp_Object
751 unlock_file_handle_error (Lisp_Object err)
752 {
753 call1 (intern ("userlock--handle-unlock-error"), err);
754 return Qnil;
755 }
756
757 #endif /* MSDOS */
758
759 void
760 unlock_all_files (void)
761 {
762 register Lisp_Object tail, buf;
763 register struct buffer *b;
764
765 FOR_EACH_LIVE_BUFFER (tail, buf)
766 {
767 b = XBUFFER (buf);
768 if (STRINGP (BVAR (b, file_truename))
769 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
770 Funlock_file (BVAR (b, file_truename));
771 }
772 }
773
774 DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0,
775 doc: /* Lock FILE.
776 If the option `create-lockfiles' is nil, this does nothing. */)
777 (Lisp_Object file)
778 {
779 #ifndef MSDOS
780 CHECK_STRING (file);
781
782 /* If the file name has special constructs in it,
783 call the corresponding file name handler. */
784 Lisp_Object handler;
785 handler = Ffind_file_name_handler (file, Qlock_file);
786 if (!NILP (handler))
787 return call2 (handler, Qlock_file, file);
788
789 lock_file (file);
790 #endif /* MSDOS */
791 return Qnil;
792 }
793
794 DEFUN ("unlock-file", Funlock_file, Sunlock_file, 1, 1, 0,
795 doc: /* Unlock FILE. */)
796 (Lisp_Object file)
797 {
798 #ifndef MSDOS
799 CHECK_STRING (file);
800
801 /* If the file name has special constructs in it,
802 call the corresponding file name handler. */
803 Lisp_Object handler;
804 handler = Ffind_file_name_handler (file, Qunlock_file);
805 if (!NILP (handler))
806 {
807 call2 (handler, Qunlock_file, file);
808 return Qnil;
809 }
810
811 internal_condition_case_1 (unlock_file,
812 file,
813 list1 (Qfile_error),
814 unlock_file_handle_error);
815 #endif /* MSDOS */
816 return Qnil;
817 }
818
819 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
820 0, 1, 0,
821 doc: /* Lock FILE, if current buffer is modified.
822 FILE defaults to current buffer's visited file,
823 or else nothing is done if current buffer isn't visiting a file.
824
825 If the option `create-lockfiles' is nil, this does nothing. */)
826 (Lisp_Object file)
827 {
828 if (NILP (file))
829 file = BVAR (current_buffer, file_truename);
830 else
831 CHECK_STRING (file);
832 if (SAVE_MODIFF < MODIFF
833 && !NILP (file))
834 Flock_file (file);
835 return Qnil;
836 }
837
838 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
839 0, 0, 0,
840 doc: /* Unlock the file visited in the current buffer.
841 If the buffer is not modified, this does nothing because the file
842 should not be locked in that case. It also does nothing if the
843 current buffer is not visiting a file, or is not locked. Handles file
844 system errors by calling `display-warning' and continuing as if the
845 error did not occur. */)
846 (void)
847 {
848 if (SAVE_MODIFF < MODIFF
849 && STRINGP (BVAR (current_buffer, file_truename)))
850 Funlock_file (BVAR (current_buffer, file_truename));
851 return Qnil;
852 }
853
854 /* Unlock the file visited in buffer BUFFER. */
855
856 void
857 unlock_buffer (struct buffer *buffer)
858 {
859 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
860 && STRINGP (BVAR (buffer, file_truename)))
861 Funlock_file (BVAR (buffer, file_truename));
862 }
863
864 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
865 doc: /* Return a value indicating whether FILENAME is locked.
866 The value is nil if the FILENAME is not locked,
867 t if it is locked by you, else a string saying which user has locked it. */)
868 (Lisp_Object filename)
869 {
870 #ifdef MSDOS
871 return Qnil;
872 #else
873 Lisp_Object ret;
874 int owner;
875 lock_info_type locker;
876
877 /* If the file name has special constructs in it,
878 call the corresponding file name handler. */
879 Lisp_Object handler;
880 handler = Ffind_file_name_handler (filename, Qfile_locked_p);
881 if (!NILP (handler))
882 {
883 return call2 (handler, Qfile_locked_p, filename);
884 }
885
886 Lisp_Object lfname = make_lock_file_name (filename);
887 if (NILP (lfname))
888 return Qnil;
889
890 owner = current_lock_owner (&locker, lfname);
891 switch (owner)
892 {
893 case I_OWN_IT: ret = Qt; break;
894 case ANOTHER_OWNS_IT:
895 ret = make_string (locker.user, locker.at - locker.user);
896 break;
897 case 0: ret = Qnil; break;
898 default: report_file_errno ("Testing file lock", filename, owner);
899 }
900
901 return ret;
902 #endif
903 }
904
905 void
906 syms_of_filelock (void)
907 {
908 DEFVAR_LISP ("temporary-file-directory", Vtemporary_file_directory,
909 doc: /* The directory for writing temporary files. */);
910 Vtemporary_file_directory = Qnil;
911
912 DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
913 doc: /* Non-nil means use lockfiles to avoid editing collisions.
914 The name of the (per-buffer) lockfile is constructed by prepending
915 ".#" to the name of the file being locked. See also `lock-buffer' and
916 Info node `(emacs)Interlocking'. */);
917 create_lockfiles = true;
918
919 DEFSYM (Qlock_file, "lock-file");
920 DEFSYM (Qunlock_file, "unlock-file");
921 DEFSYM (Qfile_locked_p, "file-locked-p");
922 DEFSYM (Qmake_lock_file_name, "make-lock-file-name");
923
924 defsubr (&Slock_file);
925 defsubr (&Sunlock_file);
926 defsubr (&Slock_buffer);
927 defsubr (&Sunlock_buffer);
928 defsubr (&Sfile_locked_p);
929 }