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