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