* files.el (ctl-x-map): Bind C-x C-q to read-only-mode.
[emacs.git] / src / filelock.c
blob17f3f2532491f4f9a8cf0c774eea1dae7d3ce502
1 /* Lock files for editing.
2 Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2012
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
22 #include <sys/types.h>
23 #include <sys/stat.h>
24 #include <signal.h>
25 #include <stdio.h>
27 #ifdef HAVE_PWD_H
28 #include <pwd.h>
29 #endif
31 #include <sys/file.h>
32 #include <fcntl.h>
33 #include <unistd.h>
35 #ifdef __FreeBSD__
36 #include <sys/sysctl.h>
37 #endif /* __FreeBSD__ */
39 #include <errno.h>
41 #include "lisp.h"
42 #include "character.h"
43 #include "buffer.h"
44 #include "coding.h"
45 #include "systime.h"
47 #ifdef CLASH_DETECTION
49 #ifdef HAVE_UTMP_H
50 #include <utmp.h>
51 #endif
53 /* A file whose last-modified time is just after the most recent boot.
54 Define this to be NULL to disable checking for this file. */
55 #ifndef BOOT_TIME_FILE
56 #define BOOT_TIME_FILE "/var/run/random-seed"
57 #endif
59 #ifndef WTMP_FILE
60 #define WTMP_FILE "/var/log/wtmp"
61 #endif
63 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
64 directory, with link data `user@host.pid'. This avoids a single
65 mount (== failure) point for lock files.
67 When the host in the lock data is the current host, we can check if
68 the pid is valid with kill.
70 Otherwise, we could look at a separate file that maps hostnames to
71 reboot times to see if the remote pid can possibly be valid, since we
72 don't want Emacs to have to communicate via pipes or sockets or
73 whatever to other processes, either locally or remotely; rms says
74 that's too unreliable. Hence the separate file, which could
75 theoretically be updated by daemons running separately -- but this
76 whole idea is unimplemented; in practice, at least in our
77 environment, it seems such stale locks arise fairly infrequently, and
78 Emacs' standard methods of dealing with clashes suffice.
80 We use symlinks instead of normal files because (1) they can be
81 stored more efficiently on the filesystem, since the kernel knows
82 they will be small, and (2) all the info about the lock can be read
83 in a single system call (readlink). Although we could use regular
84 files to be useful on old systems lacking symlinks, nowadays
85 virtually all such systems are probably single-user anyway, so it
86 didn't seem worth the complication.
88 Similarly, we don't worry about a possible 14-character limit on
89 file names, because those are all the same systems that don't have
90 symlinks.
92 This is compatible with the locking scheme used by Interleaf (which
93 has contributed this implementation for Emacs), and was designed by
94 Ethan Jacobson, Kimbo Mundy, and others.
96 --karl@cs.umb.edu/karl@hq.ileaf.com. */
99 /* Return the time of the last system boot. */
101 static time_t boot_time;
102 static bool boot_time_initialized;
104 #ifdef BOOT_TIME
105 static void get_boot_time_1 (const char *, bool);
106 #endif
108 static time_t
109 get_boot_time (void)
111 #if defined (BOOT_TIME)
112 int counter;
113 #endif
115 if (boot_time_initialized)
116 return boot_time;
117 boot_time_initialized = 1;
119 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
121 int mib[2];
122 size_t size;
123 struct timeval boottime_val;
125 mib[0] = CTL_KERN;
126 mib[1] = KERN_BOOTTIME;
127 size = sizeof (boottime_val);
129 if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
131 boot_time = boottime_val.tv_sec;
132 return boot_time;
135 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
137 if (BOOT_TIME_FILE)
139 struct stat st;
140 if (stat (BOOT_TIME_FILE, &st) == 0)
142 boot_time = st.st_mtime;
143 return boot_time;
147 #if defined (BOOT_TIME)
148 #ifndef CANNOT_DUMP
149 /* The utmp routines maintain static state.
150 Don't touch that state unless we are initialized,
151 since it might not survive dumping. */
152 if (! initialized)
153 return boot_time;
154 #endif /* not CANNOT_DUMP */
156 /* Try to get boot time from utmp before wtmp,
157 since utmp is typically much smaller than wtmp.
158 Passing a null pointer causes get_boot_time_1
159 to inspect the default file, namely utmp. */
160 get_boot_time_1 ((char *) 0, 0);
161 if (boot_time)
162 return boot_time;
164 /* Try to get boot time from the current wtmp file. */
165 get_boot_time_1 (WTMP_FILE, 1);
167 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
168 for (counter = 0; counter < 20 && ! boot_time; counter++)
170 char cmd_string[sizeof WTMP_FILE ".19.gz"];
171 Lisp_Object tempname, filename;
172 bool delete_flag = 0;
174 filename = Qnil;
176 tempname = make_formatted_string
177 (cmd_string, "%s.%d", WTMP_FILE, counter);
178 if (! NILP (Ffile_exists_p (tempname)))
179 filename = tempname;
180 else
182 tempname = make_formatted_string (cmd_string, "%s.%d.gz",
183 WTMP_FILE, counter);
184 if (! NILP (Ffile_exists_p (tempname)))
186 Lisp_Object args[6];
188 /* The utmp functions on mescaline.gnu.org accept only
189 file names up to 8 characters long. Choose a 2
190 character long prefix, and call make_temp_file with
191 second arg non-zero, so that it will add not more
192 than 6 characters to the prefix. */
193 filename = Fexpand_file_name (build_string ("wt"),
194 Vtemporary_file_directory);
195 filename = make_temp_name (filename, 1);
196 args[0] = build_string ("gzip");
197 args[1] = Qnil;
198 args[2] = list2 (QCfile, filename);
199 args[3] = Qnil;
200 args[4] = build_string ("-cd");
201 args[5] = tempname;
202 Fcall_process (6, args);
203 delete_flag = 1;
207 if (! NILP (filename))
209 get_boot_time_1 (SSDATA (filename), 1);
210 if (delete_flag)
211 unlink (SSDATA (filename));
215 return boot_time;
216 #else
217 return 0;
218 #endif
221 #ifdef BOOT_TIME
222 /* Try to get the boot time from wtmp file FILENAME.
223 This succeeds if that file contains a reboot record.
225 If FILENAME is zero, use the same file as before;
226 if no FILENAME has ever been specified, this is the utmp file.
227 Use the newest reboot record if NEWEST,
228 the first reboot record otherwise.
229 Ignore all reboot records on or before BOOT_TIME.
230 Success is indicated by setting BOOT_TIME to a larger value. */
232 void
233 get_boot_time_1 (const char *filename, bool newest)
235 struct utmp ut, *utp;
236 int desc;
238 if (filename)
240 /* On some versions of IRIX, opening a nonexistent file name
241 is likely to crash in the utmp routines. */
242 desc = emacs_open (filename, O_RDONLY, 0);
243 if (desc < 0)
244 return;
246 emacs_close (desc);
248 utmpname (filename);
251 setutent ();
253 while (1)
255 /* Find the next reboot record. */
256 ut.ut_type = BOOT_TIME;
257 utp = getutid (&ut);
258 if (! utp)
259 break;
260 /* Compare reboot times and use the newest one. */
261 if (utp->ut_time > boot_time)
263 boot_time = utp->ut_time;
264 if (! newest)
265 break;
267 /* Advance on element in the file
268 so that getutid won't repeat the same one. */
269 utp = getutent ();
270 if (! utp)
271 break;
273 endutent ();
275 #endif /* BOOT_TIME */
277 /* Here is the structure that stores information about a lock. */
279 typedef struct
281 char *user;
282 char *host;
283 pid_t pid;
284 time_t boot_time;
285 } lock_info_type;
287 /* Free the two dynamically-allocated pieces in PTR. */
288 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
291 /* Write the name of the lock file for FN into LFNAME. Length will be
292 that of FN plus two more for the leading `.#' plus 1 for the
293 trailing period plus one for the digit after it plus one for the
294 null. */
295 #define MAKE_LOCK_NAME(lock, file) \
296 (lock = alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
297 fill_in_lock_file_name (lock, (file)))
299 static void
300 fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
302 ptrdiff_t length = SBYTES (fn);
303 register char *p;
304 struct stat st;
305 int count = 0;
307 strcpy (lockfile, SSDATA (fn));
309 /* Shift the nondirectory part of the file name (including the null)
310 right two characters. Here is one of the places where we'd have to
311 do something to support 14-character-max file names. */
312 for (p = lockfile + length; p != lockfile && *p != '/'; p--)
313 p[2] = *p;
315 /* Insert the `.#'. */
316 p[1] = '.';
317 p[2] = '#';
319 p = p + length + 2;
321 while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
323 if (count > 9)
325 *p = '\0';
326 return;
328 sprintf (p, ".%d", count++);
332 /* Lock the lock file named LFNAME.
333 If FORCE, do so even if it is already locked.
334 Return true if successful. */
336 static bool
337 lock_file_1 (char *lfname, bool force)
339 int err;
340 int symlink_errno;
341 USE_SAFE_ALLOCA;
343 /* Call this first because it can GC. */
344 printmax_t boot = get_boot_time ();
346 Lisp_Object luser_name = Fuser_login_name (Qnil);
347 char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
348 Lisp_Object lhost_name = Fsystem_name ();
349 char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : "";
350 ptrdiff_t lock_info_size = (strlen (user_name) + strlen (host_name)
351 + 2 * INT_STRLEN_BOUND (printmax_t)
352 + sizeof "@.:");
353 char *lock_info_str = SAFE_ALLOCA (lock_info_size);
354 printmax_t pid = getpid ();
356 esprintf (lock_info_str, boot ? "%s@%s.%"pMd":%"pMd : "%s@%s.%"pMd,
357 user_name, host_name, pid, boot);
359 err = symlink (lock_info_str, lfname);
360 if (errno == EEXIST && force)
362 unlink (lfname);
363 err = symlink (lock_info_str, lfname);
366 symlink_errno = errno;
367 SAFE_FREE ();
368 errno = symlink_errno;
369 return err == 0;
372 /* Return true if times A and B are no more than one second apart. */
374 static bool
375 within_one_second (time_t a, time_t b)
377 return (a - b >= -1 && a - b <= 1);
380 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
381 1 if another process owns it (and set OWNER (if non-null) to info),
382 2 if the current process owns it,
383 or -1 if something is wrong with the locking mechanism. */
385 static int
386 current_lock_owner (lock_info_type *owner, char *lfname)
388 int ret;
389 ptrdiff_t len;
390 lock_info_type local_owner;
391 intmax_t n;
392 char *at, *dot, *colon;
393 char readlink_buf[READLINK_BUFSIZE];
394 char *lfinfo = emacs_readlink (lfname, readlink_buf);
396 /* If nonexistent lock file, all is well; otherwise, got strange error. */
397 if (!lfinfo)
398 return errno == ENOENT ? 0 : -1;
400 /* Even if the caller doesn't want the owner info, we still have to
401 read it to determine return value. */
402 if (!owner)
403 owner = &local_owner;
405 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
406 /* The USER is everything before the last @. */
407 at = strrchr (lfinfo, '@');
408 dot = strrchr (lfinfo, '.');
409 if (!at || !dot)
411 if (lfinfo != readlink_buf)
412 xfree (lfinfo);
413 return -1;
415 len = at - lfinfo;
416 owner->user = xmalloc (len + 1);
417 memcpy (owner->user, lfinfo, len);
418 owner->user[len] = 0;
420 /* The PID is everything from the last `.' to the `:'. */
421 errno = 0;
422 n = strtoimax (dot + 1, NULL, 10);
423 owner->pid =
424 ((0 <= n && n <= TYPE_MAXIMUM (pid_t)
425 && (TYPE_MAXIMUM (pid_t) < INTMAX_MAX || errno != ERANGE))
426 ? n : 0);
428 colon = strchr (dot + 1, ':');
429 /* After the `:', if there is one, comes the boot time. */
430 n = 0;
431 if (colon)
433 errno = 0;
434 n = strtoimax (colon + 1, NULL, 10);
436 owner->boot_time =
437 ((0 <= n && n <= TYPE_MAXIMUM (time_t)
438 && (TYPE_MAXIMUM (time_t) < INTMAX_MAX || errno != ERANGE))
439 ? n : 0);
441 /* The host is everything in between. */
442 len = dot - at - 1;
443 owner->host = xmalloc (len + 1);
444 memcpy (owner->host, at + 1, len);
445 owner->host[len] = 0;
447 /* We're done looking at the link info. */
448 if (lfinfo != readlink_buf)
449 xfree (lfinfo);
451 /* On current host? */
452 if (STRINGP (Fsystem_name ())
453 && strcmp (owner->host, SSDATA (Fsystem_name ())) == 0)
455 if (owner->pid == getpid ())
456 ret = 2; /* We own it. */
457 else if (owner->pid > 0
458 && (kill (owner->pid, 0) >= 0 || errno == EPERM)
459 && (owner->boot_time == 0
460 || within_one_second (owner->boot_time, get_boot_time ())))
461 ret = 1; /* An existing process on this machine owns it. */
462 /* The owner process is dead or has a strange pid (<=0), so try to
463 zap the lockfile. */
464 else if (unlink (lfname) < 0)
465 ret = -1;
466 else
467 ret = 0;
469 else
470 { /* If we wanted to support the check for stale locks on remote machines,
471 here's where we'd do it. */
472 ret = 1;
475 /* Avoid garbage. */
476 if (owner == &local_owner || ret <= 0)
478 FREE_LOCK_INFO (*owner);
480 return ret;
484 /* Lock the lock named LFNAME if possible.
485 Return 0 in that case.
486 Return positive if some other process owns the lock, and info about
487 that process in CLASHER.
488 Return -1 if cannot lock for any other reason. */
490 static int
491 lock_if_free (lock_info_type *clasher, register char *lfname)
493 while (! lock_file_1 (lfname, 0))
495 int locker;
497 if (errno != EEXIST)
498 return -1;
500 locker = current_lock_owner (clasher, lfname);
501 if (locker == 2)
503 FREE_LOCK_INFO (*clasher);
504 return 0; /* We ourselves locked it. */
506 else if (locker == 1)
507 return 1; /* Someone else has it. */
508 else if (locker == -1)
509 return -1; /* current_lock_owner returned strange error. */
511 /* We deleted a stale lock; try again to lock the file. */
513 return 0;
516 /* lock_file locks file FN,
517 meaning it serves notice on the world that you intend to edit that file.
518 This should be done only when about to modify a file-visiting
519 buffer previously unmodified.
520 Do not (normally) call this for a buffer already modified,
521 as either the file is already locked, or the user has already
522 decided to go ahead without locking.
524 When this returns, either the lock is locked for us,
525 or the user has said to go ahead without locking.
527 If the file is locked by someone else, this calls
528 ask-user-about-lock (a Lisp function) with two arguments,
529 the file name and info about the user who did the locking.
530 This function can signal an error, or return t meaning
531 take away the lock, or return nil meaning ignore the lock. */
533 void
534 lock_file (Lisp_Object fn)
536 register Lisp_Object attack, orig_fn, encoded_fn;
537 register char *lfname, *locker;
538 ptrdiff_t locker_size;
539 lock_info_type lock_info;
540 printmax_t pid;
541 struct gcpro gcpro1;
542 USE_SAFE_ALLOCA;
544 /* Don't do locking if the user has opted out. */
545 if (! create_lockfiles)
546 return;
548 /* Don't do locking while dumping Emacs.
549 Uncompressing wtmp files uses call-process, which does not work
550 in an uninitialized Emacs. */
551 if (! NILP (Vpurify_flag))
552 return;
554 orig_fn = fn;
555 GCPRO1 (fn);
556 fn = Fexpand_file_name (fn, Qnil);
557 encoded_fn = ENCODE_FILE (fn);
559 /* Create the name of the lock-file for file fn */
560 MAKE_LOCK_NAME (lfname, encoded_fn);
562 /* See if this file is visited and has changed on disk since it was
563 visited. */
565 register Lisp_Object subject_buf;
567 subject_buf = get_truename_buffer (orig_fn);
569 if (!NILP (subject_buf)
570 && NILP (Fverify_visited_file_modtime (subject_buf))
571 && !NILP (Ffile_exists_p (fn)))
572 call1 (intern ("ask-user-about-supersession-threat"), fn);
575 UNGCPRO;
577 /* Try to lock the lock. */
578 if (lock_if_free (&lock_info, lfname) <= 0)
579 /* Return now if we have locked it, or if lock creation failed */
580 return;
582 /* Else consider breaking the lock */
583 locker_size = (strlen (lock_info.user) + strlen (lock_info.host)
584 + INT_STRLEN_BOUND (printmax_t)
585 + sizeof "@ (pid )");
586 locker = SAFE_ALLOCA (locker_size);
587 pid = lock_info.pid;
588 esprintf (locker, "%s@%s (pid %"pMd")",
589 lock_info.user, lock_info.host, pid);
590 FREE_LOCK_INFO (lock_info);
592 attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
593 SAFE_FREE ();
594 if (!NILP (attack))
595 /* User says take the lock */
597 lock_file_1 (lfname, 1);
598 return;
600 /* User says ignore the lock */
603 void
604 unlock_file (register Lisp_Object fn)
606 register char *lfname;
608 fn = Fexpand_file_name (fn, Qnil);
609 fn = ENCODE_FILE (fn);
611 MAKE_LOCK_NAME (lfname, fn);
613 if (current_lock_owner (0, lfname) == 2)
614 unlink (lfname);
617 void
618 unlock_all_files (void)
620 register Lisp_Object tail;
621 register struct buffer *b;
623 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
625 b = XBUFFER (XCDR (XCAR (tail)));
626 if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
628 unlock_file (BVAR (b, file_truename));
633 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
634 0, 1, 0,
635 doc: /* Lock FILE, if current buffer is modified.
636 FILE defaults to current buffer's visited file,
637 or else nothing is done if current buffer isn't visiting a file. */)
638 (Lisp_Object file)
640 if (NILP (file))
641 file = BVAR (current_buffer, file_truename);
642 else
643 CHECK_STRING (file);
644 if (SAVE_MODIFF < MODIFF
645 && !NILP (file))
646 lock_file (file);
647 return Qnil;
650 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
651 0, 0, 0,
652 doc: /* Unlock the file visited in the current buffer.
653 If the buffer is not modified, this does nothing because the file
654 should not be locked in that case. */)
655 (void)
657 if (SAVE_MODIFF < MODIFF
658 && STRINGP (BVAR (current_buffer, file_truename)))
659 unlock_file (BVAR (current_buffer, file_truename));
660 return Qnil;
663 /* Unlock the file visited in buffer BUFFER. */
665 void
666 unlock_buffer (struct buffer *buffer)
668 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
669 && STRINGP (BVAR (buffer, file_truename)))
670 unlock_file (BVAR (buffer, file_truename));
673 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
674 doc: /* Return a value indicating whether FILENAME is locked.
675 The value is nil if the FILENAME is not locked,
676 t if it is locked by you, else a string saying which user has locked it. */)
677 (Lisp_Object filename)
679 Lisp_Object ret;
680 register char *lfname;
681 int owner;
682 lock_info_type locker;
684 filename = Fexpand_file_name (filename, Qnil);
686 MAKE_LOCK_NAME (lfname, filename);
688 owner = current_lock_owner (&locker, lfname);
689 if (owner <= 0)
690 ret = Qnil;
691 else if (owner == 2)
692 ret = Qt;
693 else
694 ret = build_string (locker.user);
696 if (owner > 0)
697 FREE_LOCK_INFO (locker);
699 return ret;
702 #endif /* CLASH_DETECTION */
704 void
705 syms_of_filelock (void)
707 DEFVAR_LISP ("temporary-file-directory", Vtemporary_file_directory,
708 doc: /* The directory for writing temporary files. */);
709 Vtemporary_file_directory = Qnil;
711 DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
712 doc: /* Non-nil means use lockfiles to avoid editing collisions. */);
713 create_lockfiles = 1;
715 #ifdef CLASH_DETECTION
716 defsubr (&Sunlock_buffer);
717 defsubr (&Slock_buffer);
718 defsubr (&Sfile_locked_p);
719 #endif