1 /* Lock files for editing.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 1998, 1999, 2000, 2001,
3 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
25 #include <sys/types.h>
47 #include <sys/sysctl.h>
48 #endif /* __FreeBSD__ */
61 /* The directory for writing temporary files. */
63 Lisp_Object Vtemporary_file_directory
;
65 #ifdef CLASH_DETECTION
69 #if !defined (S_ISLNK) && defined (S_IFLNK)
70 #define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
73 /* A file whose last-modified time is just after the most recent boot.
74 Define this to be NULL to disable checking for this file. */
75 #ifndef BOOT_TIME_FILE
76 #define BOOT_TIME_FILE "/var/run/random-seed"
80 #define WTMP_FILE "/var/log/wtmp"
83 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
84 directory, with link data `user@host.pid'. This avoids a single
85 mount (== failure) point for lock files.
87 When the host in the lock data is the current host, we can check if
88 the pid is valid with kill.
90 Otherwise, we could look at a separate file that maps hostnames to
91 reboot times to see if the remote pid can possibly be valid, since we
92 don't want Emacs to have to communicate via pipes or sockets or
93 whatever to other processes, either locally or remotely; rms says
94 that's too unreliable. Hence the separate file, which could
95 theoretically be updated by daemons running separately -- but this
96 whole idea is unimplemented; in practice, at least in our
97 environment, it seems such stale locks arise fairly infrequently, and
98 Emacs' standard methods of dealing with clashes suffice.
100 We use symlinks instead of normal files because (1) they can be
101 stored more efficiently on the filesystem, since the kernel knows
102 they will be small, and (2) all the info about the lock can be read
103 in a single system call (readlink). Although we could use regular
104 files to be useful on old systems lacking symlinks, nowadays
105 virtually all such systems are probably single-user anyway, so it
106 didn't seem worth the complication.
108 Similarly, we don't worry about a possible 14-character limit on
109 file names, because those are all the same systems that don't have
112 This is compatible with the locking scheme used by Interleaf (which
113 has contributed this implementation for Emacs), and was designed by
114 Ethan Jacobson, Kimbo Mundy, and others.
116 --karl@cs.umb.edu/karl@hq.ileaf.com. */
119 /* Return the time of the last system boot. */
121 static time_t boot_time
;
122 static int boot_time_initialized
;
124 extern Lisp_Object Vshell_file_name
;
127 static void get_boot_time_1
P_ ((char *, int));
133 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
137 if (boot_time_initialized
)
139 boot_time_initialized
= 1;
141 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
145 struct timeval boottime_val
;
148 mib
[1] = KERN_BOOTTIME
;
149 size
= sizeof (boottime_val
);
151 if (sysctl (mib
, 2, &boottime_val
, &size
, NULL
, 0) >= 0)
153 boot_time
= boottime_val
.tv_sec
;
157 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
162 if (stat (BOOT_TIME_FILE
, &st
) == 0)
164 boot_time
= st
.st_mtime
;
169 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
171 /* The utmp routines maintain static state.
172 Don't touch that state unless we are initialized,
173 since it might not survive dumping. */
176 #endif /* not CANNOT_DUMP */
178 /* Try to get boot time from utmp before wtmp,
179 since utmp is typically much smaller than wtmp.
180 Passing a null pointer causes get_boot_time_1
181 to inspect the default file, namely utmp. */
182 get_boot_time_1 ((char *) 0, 0);
186 /* Try to get boot time from the current wtmp file. */
187 get_boot_time_1 (WTMP_FILE
, 1);
189 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
190 for (counter
= 0; counter
< 20 && ! boot_time
; counter
++)
192 char cmd_string
[100];
193 Lisp_Object tempname
, filename
;
198 sprintf (cmd_string
, "%s.%d", WTMP_FILE
, counter
);
199 tempname
= build_string (cmd_string
);
200 if (! NILP (Ffile_exists_p (tempname
)))
204 sprintf (cmd_string
, "%s.%d.gz", WTMP_FILE
, counter
);
205 tempname
= build_string (cmd_string
);
206 if (! NILP (Ffile_exists_p (tempname
)))
210 /* The utmp functions on mescaline.gnu.org accept only
211 file names up to 8 characters long. Choose a 2
212 character long prefix, and call make_temp_file with
213 second arg non-zero, so that it will add not more
214 than 6 characters to the prefix. */
215 tempname
= Fexpand_file_name (build_string ("wt"),
216 Vtemporary_file_directory
);
217 tempname
= make_temp_name (tempname
, 1);
218 args
[0] = Vshell_file_name
;
222 args
[4] = build_string ("-c");
223 sprintf (cmd_string
, "gunzip < %s.%d.gz > %s",
224 WTMP_FILE
, counter
, SDATA (tempname
));
225 args
[5] = build_string (cmd_string
);
226 Fcall_process (6, args
);
232 if (! NILP (filename
))
234 get_boot_time_1 (SDATA (filename
), 1);
236 unlink (SDATA (filename
));
247 /* Try to get the boot time from wtmp file FILENAME.
248 This succeeds if that file contains a reboot record.
250 If FILENAME is zero, use the same file as before;
251 if no FILENAME has ever been specified, this is the utmp file.
252 Use the newest reboot record if NEWEST is nonzero,
253 the first reboot record otherwise.
254 Ignore all reboot records on or before BOOT_TIME.
255 Success is indicated by setting BOOT_TIME to a larger value. */
258 get_boot_time_1 (filename
, newest
)
262 struct utmp ut
, *utp
;
267 /* On some versions of IRIX, opening a nonexistent file name
268 is likely to crash in the utmp routines. */
269 desc
= emacs_open (filename
, O_RDONLY
, 0);
282 /* Find the next reboot record. */
283 ut
.ut_type
= BOOT_TIME
;
287 /* Compare reboot times and use the newest one. */
288 if (utp
->ut_time
> boot_time
)
290 boot_time
= utp
->ut_time
;
294 /* Advance on element in the file
295 so that getutid won't repeat the same one. */
302 #endif /* BOOT_TIME */
304 /* Here is the structure that stores information about a lock. */
314 /* When we read the info back, we might need this much more,
315 enough for decimal representation plus null. */
316 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
318 /* Free the two dynamically-allocated pieces in PTR. */
319 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
322 /* Write the name of the lock file for FN into LFNAME. Length will be
323 that of FN plus two more for the leading `.#' plus 1 for the
324 trailing period plus one for the digit after it plus one for the
326 #define MAKE_LOCK_NAME(lock, file) \
327 (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
328 fill_in_lock_file_name (lock, (file)))
331 fill_in_lock_file_name (lockfile
, fn
)
332 register char *lockfile
;
333 register Lisp_Object fn
;
339 strcpy (lockfile
, SDATA (fn
));
341 /* Shift the nondirectory part of the file name (including the null)
342 right two characters. Here is one of the places where we'd have to
343 do something to support 14-character-max file names. */
344 for (p
= lockfile
+ strlen (lockfile
); p
!= lockfile
&& *p
!= '/'; p
--)
347 /* Insert the `.#'. */
353 while (lstat (lockfile
, &st
) == 0 && !S_ISLNK (st
.st_mode
))
360 sprintf (p
, ".%d", count
++);
364 /* Lock the lock file named LFNAME.
365 If FORCE is nonzero, we do so even if it is already locked.
366 Return 1 if successful, 0 if not. */
369 lock_file_1 (lfname
, force
)
379 /* Call this first because it can GC. */
380 boot_time
= get_boot_time ();
382 if (STRINGP (Fuser_login_name (Qnil
)))
383 user_name
= (char *)SDATA (Fuser_login_name (Qnil
));
386 if (STRINGP (Fsystem_name ()))
387 host_name
= (char *)SDATA (Fsystem_name ());
390 lock_info_str
= (char *)alloca (strlen (user_name
) + strlen (host_name
)
391 + LOCK_PID_MAX
+ 30);
394 sprintf (lock_info_str
, "%s@%s.%lu:%lu", user_name
, host_name
,
395 (unsigned long) getpid (), (unsigned long) boot_time
);
397 sprintf (lock_info_str
, "%s@%s.%lu", user_name
, host_name
,
398 (unsigned long) getpid ());
400 err
= symlink (lock_info_str
, lfname
);
401 if (errno
== EEXIST
&& force
)
404 err
= symlink (lock_info_str
, lfname
);
410 /* Return 1 if times A and B are no more than one second apart. */
413 within_one_second (a
, b
)
416 return (a
- b
>= -1 && a
- b
<= 1);
419 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
420 1 if another process owns it (and set OWNER (if non-null) to info),
421 2 if the current process owns it,
422 or -1 if something is wrong with the locking mechanism. */
425 current_lock_owner (owner
, lfname
)
426 lock_info_type
*owner
;
430 extern char *rindex (), *index ();
434 char *at
, *dot
, *colon
;
437 /* Read arbitrarily-long contents of symlink. Similar code in
438 file-symlink-p in fileio.c. */
442 lfinfo
= (char *) xrealloc (lfinfo
, bufsize
);
444 len
= readlink (lfname
, lfinfo
, bufsize
);
446 /* HP-UX reports ERANGE if the buffer is too small. */
447 if (len
== -1 && errno
== ERANGE
)
451 while (len
>= bufsize
);
453 /* If nonexistent lock file, all is well; otherwise, got strange error. */
457 return errno
== ENOENT
? 0 : -1;
460 /* Link info exists, so `len' is its length. Null terminate. */
463 /* Even if the caller doesn't want the owner info, we still have to
464 read it to determine return value, so allocate it. */
467 owner
= (lock_info_type
*) alloca (sizeof (lock_info_type
));
471 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
472 /* The USER is everything before the last @. */
473 at
= rindex (lfinfo
, '@');
474 dot
= rindex (lfinfo
, '.');
481 owner
->user
= (char *) xmalloc (len
+ 1);
482 strncpy (owner
->user
, lfinfo
, len
);
483 owner
->user
[len
] = 0;
485 /* The PID is everything from the last `.' to the `:'. */
486 owner
->pid
= atoi (dot
+ 1);
488 while (*colon
&& *colon
!= ':')
490 /* After the `:', if there is one, comes the boot time. */
492 owner
->boot_time
= atoi (colon
+ 1);
494 owner
->boot_time
= 0;
496 /* The host is everything in between. */
498 owner
->host
= (char *) xmalloc (len
+ 1);
499 strncpy (owner
->host
, at
+ 1, len
);
500 owner
->host
[len
] = 0;
502 /* We're done looking at the link info. */
505 /* On current host? */
506 if (STRINGP (Fsystem_name ())
507 && strcmp (owner
->host
, SDATA (Fsystem_name ())) == 0)
509 if (owner
->pid
== getpid ())
510 ret
= 2; /* We own it. */
511 else if (owner
->pid
> 0
512 && (kill (owner
->pid
, 0) >= 0 || errno
== EPERM
)
513 && (owner
->boot_time
== 0
514 || within_one_second (owner
->boot_time
, get_boot_time ())))
515 ret
= 1; /* An existing process on this machine owns it. */
516 /* The owner process is dead or has a strange pid (<=0), so try to
518 else if (unlink (lfname
) < 0)
524 { /* If we wanted to support the check for stale locks on remote machines,
525 here's where we'd do it. */
530 if (local_owner
|| ret
<= 0)
532 FREE_LOCK_INFO (*owner
);
538 /* Lock the lock named LFNAME if possible.
539 Return 0 in that case.
540 Return positive if some other process owns the lock, and info about
541 that process in CLASHER.
542 Return -1 if cannot lock for any other reason. */
545 lock_if_free (clasher
, lfname
)
546 lock_info_type
*clasher
;
547 register char *lfname
;
549 while (lock_file_1 (lfname
, 0) == 0)
556 locker
= current_lock_owner (clasher
, lfname
);
559 FREE_LOCK_INFO (*clasher
);
560 return 0; /* We ourselves locked it. */
562 else if (locker
== 1)
563 return 1; /* Someone else has it. */
564 else if (locker
== -1)
565 return -1; /* current_lock_owner returned strange error. */
567 /* We deleted a stale lock; try again to lock the file. */
572 /* lock_file locks file FN,
573 meaning it serves notice on the world that you intend to edit that file.
574 This should be done only when about to modify a file-visiting
575 buffer previously unmodified.
576 Do not (normally) call this for a buffer already modified,
577 as either the file is already locked, or the user has already
578 decided to go ahead without locking.
580 When this returns, either the lock is locked for us,
581 or the user has said to go ahead without locking.
583 If the file is locked by someone else, this calls
584 ask-user-about-lock (a Lisp function) with two arguments,
585 the file name and info about the user who did the locking.
586 This function can signal an error, or return t meaning
587 take away the lock, or return nil meaning ignore the lock. */
593 register Lisp_Object attack
, orig_fn
, encoded_fn
;
594 register char *lfname
, *locker
;
595 lock_info_type lock_info
;
598 /* Don't do locking while dumping Emacs.
599 Uncompressing wtmp files uses call-process, which does not work
600 in an uninitialized Emacs. */
601 if (! NILP (Vpurify_flag
))
606 fn
= Fexpand_file_name (fn
, Qnil
);
607 encoded_fn
= ENCODE_FILE (fn
);
609 /* Create the name of the lock-file for file fn */
610 MAKE_LOCK_NAME (lfname
, encoded_fn
);
612 /* See if this file is visited and has changed on disk since it was
615 register Lisp_Object subject_buf
;
617 subject_buf
= get_truename_buffer (orig_fn
);
619 if (!NILP (subject_buf
)
620 && NILP (Fverify_visited_file_modtime (subject_buf
))
621 && !NILP (Ffile_exists_p (fn
)))
622 call1 (intern ("ask-user-about-supersession-threat"), fn
);
627 /* Try to lock the lock. */
628 if (lock_if_free (&lock_info
, lfname
) <= 0)
629 /* Return now if we have locked it, or if lock creation failed */
632 /* Else consider breaking the lock */
633 locker
= (char *) alloca (strlen (lock_info
.user
) + strlen (lock_info
.host
)
635 sprintf (locker
, "%s@%s (pid %lu)", lock_info
.user
, lock_info
.host
,
637 FREE_LOCK_INFO (lock_info
);
639 attack
= call2 (intern ("ask-user-about-lock"), fn
, build_string (locker
));
641 /* User says take the lock */
643 lock_file_1 (lfname
, 1);
646 /* User says ignore the lock */
651 register Lisp_Object fn
;
653 register char *lfname
;
655 fn
= Fexpand_file_name (fn
, Qnil
);
656 fn
= ENCODE_FILE (fn
);
658 MAKE_LOCK_NAME (lfname
, fn
);
660 if (current_lock_owner (0, lfname
) == 2)
667 register Lisp_Object tail
;
668 register struct buffer
*b
;
670 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
672 b
= XBUFFER (XCDR (XCAR (tail
)));
673 if (STRINGP (b
->file_truename
) && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
))
675 unlock_file(b
->file_truename
);
680 DEFUN ("lock-buffer", Flock_buffer
, Slock_buffer
,
682 doc
: /* Lock FILE, if current buffer is modified.
683 FILE defaults to current buffer's visited file,
684 or else nothing is done if current buffer isn't visiting a file. */)
689 file
= current_buffer
->file_truename
;
692 if (SAVE_MODIFF
< MODIFF
698 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
700 doc
: /* Unlock the file visited in the current buffer.
701 If the buffer is not modified, this does nothing because the file
702 should not be locked in that case. */)
705 if (SAVE_MODIFF
< MODIFF
706 && STRINGP (current_buffer
->file_truename
))
707 unlock_file (current_buffer
->file_truename
);
711 /* Unlock the file visited in buffer BUFFER. */
714 unlock_buffer (buffer
)
715 struct buffer
*buffer
;
717 if (BUF_SAVE_MODIFF (buffer
) < BUF_MODIFF (buffer
)
718 && STRINGP (buffer
->file_truename
))
719 unlock_file (buffer
->file_truename
);
722 DEFUN ("file-locked-p", Ffile_locked_p
, Sfile_locked_p
, 1, 1, 0,
723 doc
: /* Return a value indicating whether FILENAME is locked.
724 The value is nil if the FILENAME is not locked,
725 t if it is locked by you, else a string saying which user has locked it. */)
727 Lisp_Object filename
;
730 register char *lfname
;
732 lock_info_type locker
;
734 filename
= Fexpand_file_name (filename
, Qnil
);
736 MAKE_LOCK_NAME (lfname
, filename
);
738 owner
= current_lock_owner (&locker
, lfname
);
744 ret
= build_string (locker
.user
);
747 FREE_LOCK_INFO (locker
);
752 /* Initialization functions. */
758 boot_time_initialized
= 0;
764 DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory
,
765 doc
: /* The directory for writing temporary files. */);
766 Vtemporary_file_directory
= Qnil
;
768 defsubr (&Sunlock_buffer
);
769 defsubr (&Slock_buffer
);
770 defsubr (&Sfile_locked_p
);
773 #endif /* CLASH_DETECTION */
775 /* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1
776 (do not change this comment) */