*** empty log message ***
[emacs.git] / src / filelock.c
blob33de9a4e7dbeeae3de84e317d9a231ce47513924
1 /* Lock files for editing.
2 Copyright (C) 1985, 86, 87, 93, 94, 96, 98, 1999, 2000, 2001
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 2, or (at your option)
10 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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <signal.h>
27 #include <stdio.h>
29 #ifdef VMS
30 #include "vms-pwd.h"
31 #else
32 #include <pwd.h>
33 #endif /* not VMS */
35 #include <sys/file.h>
36 #ifdef HAVE_FCNTL_H
37 #include <fcntl.h>
38 #endif
39 #ifdef HAVE_STRING_H
40 #include <string.h>
41 #endif
43 #ifdef HAVE_UNISTD_H
44 #include <unistd.h>
45 #endif
47 #ifdef __FreeBSD__
48 #include <sys/sysctl.h>
49 #endif /* __FreeBSD__ */
51 #include <errno.h>
52 #ifndef errno
53 extern int errno;
54 #endif
56 #include "lisp.h"
57 #include "buffer.h"
58 #include "charset.h"
59 #include "coding.h"
60 #include "systime.h"
62 /* The directory for writing temporary files. */
64 Lisp_Object Vtemporary_file_directory;
66 #ifdef CLASH_DETECTION
68 #include <utmp.h>
70 #if !defined (S_ISLNK) && defined (S_IFLNK)
71 #define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
72 #endif
74 /* A file whose last-modified time is just after the most recent boot.
75 Define this to be NULL to disable checking for this file. */
76 #ifndef BOOT_TIME_FILE
77 #define BOOT_TIME_FILE "/var/run/random-seed"
78 #endif
80 #ifndef WTMP_FILE
81 #define WTMP_FILE "/var/log/wtmp"
82 #endif
84 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
85 directory, with link data `user@host.pid'. This avoids a single
86 mount (== failure) point for lock files.
88 When the host in the lock data is the current host, we can check if
89 the pid is valid with kill.
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.
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.
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.
113 This is compatible with the locking scheme used by Interleaf (which
114 has contributed this implementation for Emacs), and was designed by
115 Ethan Jacobson, Kimbo Mundy, and others.
117 --karl@cs.umb.edu/karl@hq.ileaf.com. */
120 /* Return the time of the last system boot. */
122 static time_t boot_time;
123 static int boot_time_initialized;
125 extern Lisp_Object Vshell_file_name;
127 #ifdef BOOT_TIME
128 static void get_boot_time_1 P_ ((char *, int));
129 #endif
131 static time_t
132 get_boot_time ()
134 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
135 int counter;
136 #endif
138 if (boot_time_initialized)
139 return boot_time;
140 boot_time_initialized = 1;
142 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
144 int mib[2];
145 size_t size;
146 struct timeval boottime_val;
148 mib[0] = CTL_KERN;
149 mib[1] = KERN_BOOTTIME;
150 size = sizeof (boottime_val);
152 if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
154 boot_time = boottime_val.tv_sec;
155 return boot_time;
158 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
160 if (BOOT_TIME_FILE)
162 struct stat st;
163 if (stat (BOOT_TIME_FILE, &st) == 0)
165 boot_time = st.st_mtime;
166 return boot_time;
170 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
171 #ifndef CANNOT_DUMP
172 /* The utmp routines maintain static state.
173 Don't touch that state unless we are initialized,
174 since it might not survive dumping. */
175 if (! initialized)
176 return boot_time;
177 #endif /* not CANNOT_DUMP */
179 /* Try to get boot time from utmp before wtmp,
180 since utmp is typically much smaller than wtmp.
181 Passing a null pointer causes get_boot_time_1
182 to inspect the default file, namely utmp. */
183 get_boot_time_1 ((char *) 0, 0);
184 if (boot_time)
185 return boot_time;
187 /* Try to get boot time from the current wtmp file. */
188 get_boot_time_1 (WTMP_FILE, 1);
190 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
191 for (counter = 0; counter < 20 && ! boot_time; counter++)
193 char cmd_string[100];
194 Lisp_Object tempname, filename;
195 int delete_flag = 0;
197 filename = Qnil;
199 sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
200 tempname = build_string (cmd_string);
201 if (! NILP (Ffile_exists_p (tempname)))
202 filename = tempname;
203 else
205 sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
206 tempname = build_string (cmd_string);
207 if (! NILP (Ffile_exists_p (tempname)))
209 Lisp_Object args[6];
211 /* The utmp functions on mescaline.gnu.org accept only
212 file names up to 8 characters long. Choose a 2
213 character long prefix, and call make_temp_file with
214 second arg non-zero, so that it will add not more
215 than 6 characters to the prefix. */
216 tempname = Fexpand_file_name (build_string ("wt"),
217 Vtemporary_file_directory);
218 tempname = make_temp_name (tempname, 1);
219 args[0] = Vshell_file_name;
220 args[1] = Qnil;
221 args[2] = Qnil;
222 args[3] = Qnil;
223 args[4] = build_string ("-c");
224 sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
225 WTMP_FILE, counter, SDATA (tempname));
226 args[5] = build_string (cmd_string);
227 Fcall_process (6, args);
228 filename = tempname;
229 delete_flag = 1;
233 if (! NILP (filename))
235 get_boot_time_1 (SDATA (filename), 1);
236 if (delete_flag)
237 unlink (SDATA (filename));
241 return boot_time;
242 #else
243 return 0;
244 #endif
247 #ifdef BOOT_TIME
248 /* Try to get the boot time from wtmp file FILENAME.
249 This succeeds if that file contains a reboot record.
251 If FILENAME is zero, use the same file as before;
252 if no FILENAME has ever been specified, this is the utmp file.
253 Use the newest reboot record if NEWEST is nonzero,
254 the first reboot record otherwise.
255 Ignore all reboot records on or before BOOT_TIME.
256 Success is indicated by setting BOOT_TIME to a larger value. */
258 void
259 get_boot_time_1 (filename, newest)
260 char *filename;
261 int newest;
263 struct utmp ut, *utp;
264 int desc;
266 if (filename)
268 /* On some versions of IRIX, opening a nonexistent file name
269 is likely to crash in the utmp routines. */
270 desc = emacs_open (filename, O_RDONLY, 0);
271 if (desc < 0)
272 return;
274 emacs_close (desc);
276 utmpname (filename);
279 setutent ();
281 while (1)
283 /* Find the next reboot record. */
284 ut.ut_type = BOOT_TIME;
285 utp = getutid (&ut);
286 if (! utp)
287 break;
288 /* Compare reboot times and use the newest one. */
289 if (utp->ut_time > boot_time)
291 boot_time = utp->ut_time;
292 if (! newest)
293 break;
295 /* Advance on element in the file
296 so that getutid won't repeat the same one. */
297 utp = getutent ();
298 if (! utp)
299 break;
301 endutent ();
303 #endif /* BOOT_TIME */
305 /* Here is the structure that stores information about a lock. */
307 typedef struct
309 char *user;
310 char *host;
311 unsigned long pid;
312 time_t boot_time;
313 } lock_info_type;
315 /* When we read the info back, we might need this much more,
316 enough for decimal representation plus null. */
317 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
319 /* Free the two dynamically-allocated pieces in PTR. */
320 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
323 /* Write the name of the lock file for FN into LFNAME. Length will be
324 that of FN plus two more for the leading `.#' plus 1 for the
325 trailing period plus one for the digit after it plus one for the
326 null. */
327 #define MAKE_LOCK_NAME(lock, file) \
328 (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
329 fill_in_lock_file_name (lock, (file)))
331 static void
332 fill_in_lock_file_name (lockfile, fn)
333 register char *lockfile;
334 register Lisp_Object fn;
336 register char *p;
337 struct stat st;
338 int count = 0;
340 strcpy (lockfile, SDATA (fn));
342 /* Shift the nondirectory part of the file name (including the null)
343 right two characters. Here is one of the places where we'd have to
344 do something to support 14-character-max file names. */
345 for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
346 p[2] = *p;
348 /* Insert the `.#'. */
349 p[1] = '.';
350 p[2] = '#';
352 p = p + strlen (p);
354 while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
356 if (count > 9)
358 *p = '\0';
359 return;
361 sprintf (p, ".%d", count++);
365 /* Lock the lock file named LFNAME.
366 If FORCE is nonzero, we do so even if it is already locked.
367 Return 1 if successful, 0 if not. */
369 static int
370 lock_file_1 (lfname, force)
371 char *lfname;
372 int force;
374 register int err;
375 time_t boot_time;
376 char *user_name;
377 char *host_name;
378 char *lock_info_str;
380 if (STRINGP (Fuser_login_name (Qnil)))
381 user_name = (char *)SDATA (Fuser_login_name (Qnil));
382 else
383 user_name = "";
384 if (STRINGP (Fsystem_name ()))
385 host_name = (char *)SDATA (Fsystem_name ());
386 else
387 host_name = "";
388 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
389 + LOCK_PID_MAX + 5);
391 boot_time = get_boot_time ();
392 if (boot_time)
393 sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name,
394 (unsigned long) getpid (), (unsigned long) boot_time);
395 else
396 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
397 (unsigned long) getpid ());
399 err = symlink (lock_info_str, lfname);
400 if (errno == EEXIST && force)
402 unlink (lfname);
403 err = symlink (lock_info_str, lfname);
406 return err == 0;
409 /* Return 1 if times A and B are no more than one second apart. */
412 within_one_second (a, b)
413 time_t a, b;
415 return (a - b >= -1 && a - b <= 1);
418 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
419 1 if another process owns it (and set OWNER (if non-null) to info),
420 2 if the current process owns it,
421 or -1 if something is wrong with the locking mechanism. */
423 static int
424 current_lock_owner (owner, lfname)
425 lock_info_type *owner;
426 char *lfname;
428 #ifndef index
429 extern char *rindex (), *index ();
430 #endif
431 int len, ret;
432 int local_owner = 0;
433 char *at, *dot, *colon;
434 char *lfinfo = 0;
435 int bufsize = 50;
436 /* Read arbitrarily-long contents of symlink. Similar code in
437 file-symlink-p in fileio.c. */
440 bufsize *= 2;
441 lfinfo = (char *) xrealloc (lfinfo, bufsize);
442 errno = 0;
443 len = readlink (lfname, lfinfo, bufsize);
444 #ifdef ERANGE
445 /* HP-UX reports ERANGE if the buffer is too small. */
446 if (len == -1 && errno == ERANGE)
447 len = bufsize;
448 #endif
450 while (len >= bufsize);
452 /* If nonexistent lock file, all is well; otherwise, got strange error. */
453 if (len == -1)
455 xfree (lfinfo);
456 return errno == ENOENT ? 0 : -1;
459 /* Link info exists, so `len' is its length. Null terminate. */
460 lfinfo[len] = 0;
462 /* Even if the caller doesn't want the owner info, we still have to
463 read it to determine return value, so allocate it. */
464 if (!owner)
466 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
467 local_owner = 1;
470 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
471 /* The USER is everything before the first @. */
472 at = index (lfinfo, '@');
473 dot = rindex (lfinfo, '.');
474 if (!at || !dot)
476 xfree (lfinfo);
477 return -1;
479 len = at - lfinfo;
480 owner->user = (char *) xmalloc (len + 1);
481 strncpy (owner->user, lfinfo, len);
482 owner->user[len] = 0;
484 /* The PID is everything from the last `.' to the `:'. */
485 owner->pid = atoi (dot + 1);
486 colon = dot;
487 while (*colon && *colon != ':')
488 colon++;
489 /* After the `:', if there is one, comes the boot time. */
490 if (*colon == ':')
491 owner->boot_time = atoi (colon + 1);
492 else
493 owner->boot_time = 0;
495 /* The host is everything in between. */
496 len = dot - at - 1;
497 owner->host = (char *) xmalloc (len + 1);
498 strncpy (owner->host, at + 1, len);
499 owner->host[len] = 0;
501 /* We're done looking at the link info. */
502 xfree (lfinfo);
504 /* On current host? */
505 if (STRINGP (Fsystem_name ())
506 && strcmp (owner->host, SDATA (Fsystem_name ())) == 0)
508 if (owner->pid == getpid ())
509 ret = 2; /* We own it. */
510 else if (owner->pid > 0
511 && (kill (owner->pid, 0) >= 0 || errno == EPERM)
512 && (owner->boot_time == 0
513 || within_one_second (owner->boot_time, get_boot_time ())))
514 ret = 1; /* An existing process on this machine owns it. */
515 /* The owner process is dead or has a strange pid (<=0), so try to
516 zap the lockfile. */
517 else if (unlink (lfname) < 0)
518 ret = -1;
519 else
520 ret = 0;
522 else
523 { /* If we wanted to support the check for stale locks on remote machines,
524 here's where we'd do it. */
525 ret = 1;
528 /* Avoid garbage. */
529 if (local_owner || ret <= 0)
531 FREE_LOCK_INFO (*owner);
533 return ret;
537 /* Lock the lock named LFNAME if possible.
538 Return 0 in that case.
539 Return positive if some other process owns the lock, and info about
540 that process in CLASHER.
541 Return -1 if cannot lock for any other reason. */
543 static int
544 lock_if_free (clasher, lfname)
545 lock_info_type *clasher;
546 register char *lfname;
548 while (lock_file_1 (lfname, 0) == 0)
550 int locker;
552 if (errno != EEXIST)
553 return -1;
555 locker = current_lock_owner (clasher, lfname);
556 if (locker == 2)
558 FREE_LOCK_INFO (*clasher);
559 return 0; /* We ourselves locked it. */
561 else if (locker == 1)
562 return 1; /* Someone else has it. */
563 else if (locker == -1)
564 return -1; /* current_lock_owner returned strange error. */
566 /* We deleted a stale lock; try again to lock the file. */
568 return 0;
571 /* lock_file locks file FN,
572 meaning it serves notice on the world that you intend to edit that file.
573 This should be done only when about to modify a file-visiting
574 buffer previously unmodified.
575 Do not (normally) call this for a buffer already modified,
576 as either the file is already locked, or the user has already
577 decided to go ahead without locking.
579 When this returns, either the lock is locked for us,
580 or the user has said to go ahead without locking.
582 If the file is locked by someone else, this calls
583 ask-user-about-lock (a Lisp function) with two arguments,
584 the file name and info about the user who did the locking.
585 This function can signal an error, or return t meaning
586 take away the lock, or return nil meaning ignore the lock. */
588 void
589 lock_file (fn)
590 Lisp_Object fn;
592 register Lisp_Object attack, orig_fn, encoded_fn;
593 register char *lfname, *locker;
594 lock_info_type lock_info;
595 struct gcpro gcpro1;
597 /* Don't do locking while dumping Emacs.
598 Uncompressing wtmp files uses call-process, which does not work
599 in an uninitialized Emacs. */
600 if (! NILP (Vpurify_flag))
601 return;
603 orig_fn = fn;
604 GCPRO1 (fn);
605 fn = Fexpand_file_name (fn, Qnil);
606 encoded_fn = ENCODE_FILE (fn);
608 /* Create the name of the lock-file for file fn */
609 MAKE_LOCK_NAME (lfname, encoded_fn);
611 /* See if this file is visited and has changed on disk since it was
612 visited. */
614 register Lisp_Object subject_buf;
616 subject_buf = get_truename_buffer (orig_fn);
618 if (!NILP (subject_buf)
619 && NILP (Fverify_visited_file_modtime (subject_buf))
620 && !NILP (Ffile_exists_p (fn)))
621 call1 (intern ("ask-user-about-supersession-threat"), fn);
624 UNGCPRO;
626 /* Try to lock the lock. */
627 if (lock_if_free (&lock_info, lfname) <= 0)
628 /* Return now if we have locked it, or if lock creation failed */
629 return;
631 /* Else consider breaking the lock */
632 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
633 + LOCK_PID_MAX + 9);
634 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
635 lock_info.pid);
636 FREE_LOCK_INFO (lock_info);
638 attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
639 if (!NILP (attack))
640 /* User says take the lock */
642 lock_file_1 (lfname, 1);
643 return;
645 /* User says ignore the lock */
648 void
649 unlock_file (fn)
650 register Lisp_Object fn;
652 register char *lfname;
654 fn = Fexpand_file_name (fn, Qnil);
655 fn = ENCODE_FILE (fn);
657 MAKE_LOCK_NAME (lfname, fn);
659 if (current_lock_owner (0, lfname) == 2)
660 unlink (lfname);
663 void
664 unlock_all_files ()
666 register Lisp_Object tail;
667 register struct buffer *b;
669 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
671 b = XBUFFER (XCDR (XCAR (tail)));
672 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
674 unlock_file(b->file_truename);
679 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
680 0, 1, 0,
681 doc: /* Lock FILE, if current buffer is modified.
682 FILE defaults to current buffer's visited file,
683 or else nothing is done if current buffer isn't visiting a file. */)
684 (file)
685 Lisp_Object file;
687 if (NILP (file))
688 file = current_buffer->file_truename;
689 else
690 CHECK_STRING (file);
691 if (SAVE_MODIFF < MODIFF
692 && !NILP (file))
693 lock_file (file);
694 return Qnil;
697 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
698 0, 0, 0,
699 doc: /* Unlock the file visited in the current buffer.
700 If the buffer is not modified, this does nothing because the file
701 should not be locked in that case. */)
704 if (SAVE_MODIFF < MODIFF
705 && STRINGP (current_buffer->file_truename))
706 unlock_file (current_buffer->file_truename);
707 return Qnil;
710 /* Unlock the file visited in buffer BUFFER. */
712 void
713 unlock_buffer (buffer)
714 struct buffer *buffer;
716 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
717 && STRINGP (buffer->file_truename))
718 unlock_file (buffer->file_truename);
721 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
722 doc: /* Return a value indicating whether FILENAME is locked.
723 The value is nil if the FILENAME is not locked,
724 t if it is locked by you, else a string saying which user has locked it. */)
725 (filename)
726 Lisp_Object filename;
728 Lisp_Object ret;
729 register char *lfname;
730 int owner;
731 lock_info_type locker;
733 filename = Fexpand_file_name (filename, Qnil);
735 MAKE_LOCK_NAME (lfname, filename);
737 owner = current_lock_owner (&locker, lfname);
738 if (owner <= 0)
739 ret = Qnil;
740 else if (owner == 2)
741 ret = Qt;
742 else
743 ret = build_string (locker.user);
745 if (owner > 0)
746 FREE_LOCK_INFO (locker);
748 return ret;
751 /* Initialization functions. */
753 void
754 init_filelock ()
756 boot_time = 0;
757 boot_time_initialized = 0;
760 void
761 syms_of_filelock ()
763 DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory,
764 doc: /* The directory for writing temporary files. */);
765 Vtemporary_file_directory = Qnil;
767 defsubr (&Sunlock_buffer);
768 defsubr (&Slock_buffer);
769 defsubr (&Sfile_locked_p);
772 #endif /* CLASH_DETECTION */