1 /* Lock files for editing.
2 Copyright (C) 1985, 86, 87, 93, 94, 96, 98, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <sys/types.h>
49 #include <sys/types.h>
50 #include <sys/sysctl.h>
51 #endif /* __FreeBSD__ */
65 /* The directory for writing temporary files. */
67 Lisp_Object Vtemporary_file_directory
;
69 #ifdef CLASH_DETECTION
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
;
129 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
133 if (boot_time_initialized
)
135 boot_time_initialized
= 1;
137 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
141 struct timeval boottime_val
;
144 mib
[1] = KERN_BOOTTIME
;
145 size
= sizeof (boottime_val
);
147 if (sysctl (mib
, 2, &boottime_val
, &size
, NULL
, 0) >= 0)
149 boot_time
= boottime_val
.tv_sec
;
153 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
158 if (stat (BOOT_TIME_FILE
, &st
) == 0)
160 boot_time
= st
.st_mtime
;
165 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
167 /* The utmp routines maintain static state.
168 Don't touch that state unless we are initialized,
169 since it might not survive dumping. */
172 #endif /* not CANNOT_DUMP */
174 /* Try to get boot time from utmp before wtmp,
175 since utmp is typically much smaller than wtmp.
176 Passing a null pointer causes get_boot_time_1
177 to inspect the default file, namely utmp. */
178 get_boot_time_1 ((char *) 0, 0);
182 /* Try to get boot time from the current wtmp file. */
183 get_boot_time_1 (WTMP_FILE
, 1);
185 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
186 for (counter
= 0; counter
< 20 && ! boot_time
; counter
++)
188 char cmd_string
[100];
189 Lisp_Object tempname
, filename
;
194 sprintf (cmd_string
, "%s.%d", WTMP_FILE
, counter
);
195 tempname
= build_string (cmd_string
);
196 if (! NILP (Ffile_exists_p (tempname
)))
200 sprintf (cmd_string
, "%s.%d.gz", WTMP_FILE
, counter
);
201 tempname
= build_string (cmd_string
);
202 if (! NILP (Ffile_exists_p (tempname
)))
205 tempname
= Fexpand_file_name (build_string ("wtmp"),
206 Vtemporary_file_directory
);
207 tempname
= Fmake_temp_name (tempname
);
208 args
[0] = Vshell_file_name
;
212 args
[4] = build_string ("-c");
213 sprintf (cmd_string
, "gunzip < %s.%d.gz > %s",
214 WTMP_FILE
, counter
, XSTRING (tempname
)->data
);
215 args
[5] = build_string (cmd_string
);
216 Fcall_process (6, args
);
222 if (! NILP (filename
))
224 get_boot_time_1 (XSTRING (filename
)->data
, 1);
226 unlink (XSTRING (filename
)->data
);
237 /* Try to get the boot time from wtmp file FILENAME.
238 This succeeds if that file contains a reboot record.
240 If FILENAME is zero, use the same file as before;
241 if no FILENAME has ever been specified, this is the utmp file.
242 Use the newest reboot record if NEWEST is nonzero,
243 the first reboot record otherwise.
244 Ignore all reboot records on or before BOOT_TIME.
245 Success is indicated by setting BOOT_TIME to a larger value. */
247 get_boot_time_1 (filename
, newest
)
251 struct utmp ut
, *utp
;
256 /* On some versions of IRIX, opening a nonexistent file name
257 is likely to crash in the utmp routines. */
258 desc
= open (filename
, O_RDONLY
);
271 /* Find the next reboot record. */
272 ut
.ut_type
= BOOT_TIME
;
276 /* Compare reboot times and use the newest one. */
277 if (utp
->ut_time
> boot_time
)
279 boot_time
= utp
->ut_time
;
283 /* Advance on element in the file
284 so that getutid won't repeat the same one. */
291 #endif /* BOOT_TIME */
293 /* Here is the structure that stores information about a lock. */
303 /* When we read the info back, we might need this much more,
304 enough for decimal representation plus null. */
305 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
307 /* Free the two dynamically-allocated pieces in PTR. */
308 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
311 /* Write the name of the lock file for FN into LFNAME. Length will be
312 that of FN plus two more for the leading `.#' plus one for the null. */
313 #define MAKE_LOCK_NAME(lock, file) \
314 (lock = (char *) alloca (STRING_BYTES (XSTRING (file)) + 2 + 1), \
315 fill_in_lock_file_name (lock, (file)))
318 fill_in_lock_file_name (lockfile
, fn
)
319 register char *lockfile
;
320 register Lisp_Object fn
;
324 strcpy (lockfile
, XSTRING (fn
)->data
);
326 /* Shift the nondirectory part of the file name (including the null)
327 right two characters. Here is one of the places where we'd have to
328 do something to support 14-character-max file names. */
329 for (p
= lockfile
+ strlen (lockfile
); p
!= lockfile
&& *p
!= '/'; p
--)
332 /* Insert the `.#'. */
337 /* Lock the lock file named LFNAME.
338 If FORCE is nonzero, we do so even if it is already locked.
339 Return 1 if successful, 0 if not. */
342 lock_file_1 (lfname
, force
)
352 if (STRINGP (Fuser_login_name (Qnil
)))
353 user_name
= (char *)XSTRING (Fuser_login_name (Qnil
))->data
;
356 if (STRINGP (Fsystem_name ()))
357 host_name
= (char *)XSTRING (Fsystem_name ())->data
;
360 lock_info_str
= (char *)alloca (strlen (user_name
) + strlen (host_name
)
363 boot_time
= get_boot_time ();
365 sprintf (lock_info_str
, "%s@%s.%lu:%lu", user_name
, host_name
,
366 (unsigned long) getpid (), (unsigned long) boot_time
);
368 sprintf (lock_info_str
, "%s@%s.%lu", user_name
, host_name
,
369 (unsigned long) getpid ());
371 err
= symlink (lock_info_str
, lfname
);
372 if (errno
== EEXIST
&& force
)
375 err
= symlink (lock_info_str
, lfname
);
381 /* Return 1 if times A and B are no more than one second apart. */
384 within_one_second (a
, b
)
387 return (a
- b
>= -1 && a
- b
<= 1);
390 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
391 1 if another process owns it (and set OWNER (if non-null) to info),
392 2 if the current process owns it,
393 or -1 if something is wrong with the locking mechanism. */
396 current_lock_owner (owner
, lfname
)
397 lock_info_type
*owner
;
401 extern char *rindex (), *index ();
405 char *at
, *dot
, *colon
;
408 /* Read arbitrarily-long contents of symlink. Similar code in
409 file-symlink-p in fileio.c. */
413 lfinfo
= (char *) xrealloc (lfinfo
, bufsize
);
414 len
= readlink (lfname
, lfinfo
, bufsize
);
416 while (len
>= bufsize
);
418 /* If nonexistent lock file, all is well; otherwise, got strange error. */
422 return errno
== ENOENT
? 0 : -1;
425 /* Link info exists, so `len' is its length. Null terminate. */
428 /* Even if the caller doesn't want the owner info, we still have to
429 read it to determine return value, so allocate it. */
432 owner
= (lock_info_type
*) alloca (sizeof (lock_info_type
));
436 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
437 /* The USER is everything before the first @. */
438 at
= index (lfinfo
, '@');
439 dot
= rindex (lfinfo
, '.');
446 owner
->user
= (char *) xmalloc (len
+ 1);
447 strncpy (owner
->user
, lfinfo
, len
);
448 owner
->user
[len
] = 0;
450 /* The PID is everything from the last `.' to the `:'. */
451 owner
->pid
= atoi (dot
+ 1);
453 while (*colon
&& *colon
!= ':')
455 /* After the `:', if there is one, comes the boot time. */
457 owner
->boot_time
= atoi (colon
+ 1);
459 owner
->boot_time
= 0;
461 /* The host is everything in between. */
463 owner
->host
= (char *) xmalloc (len
+ 1);
464 strncpy (owner
->host
, at
+ 1, len
);
465 owner
->host
[len
] = 0;
467 /* We're done looking at the link info. */
470 /* On current host? */
471 if (STRINGP (Fsystem_name ())
472 && strcmp (owner
->host
, XSTRING (Fsystem_name ())->data
) == 0)
474 if (owner
->pid
== getpid ())
475 ret
= 2; /* We own it. */
476 else if (owner
->pid
> 0
477 && (kill (owner
->pid
, 0) >= 0 || errno
== EPERM
)
478 && (owner
->boot_time
== 0
479 || within_one_second (owner
->boot_time
, get_boot_time ())))
480 ret
= 1; /* An existing process on this machine owns it. */
481 /* The owner process is dead or has a strange pid (<=0), so try to
483 else if (unlink (lfname
) < 0)
489 { /* If we wanted to support the check for stale locks on remote machines,
490 here's where we'd do it. */
495 if (local_owner
|| ret
<= 0)
497 FREE_LOCK_INFO (*owner
);
503 /* Lock the lock named LFNAME if possible.
504 Return 0 in that case.
505 Return positive if some other process owns the lock, and info about
506 that process in CLASHER.
507 Return -1 if cannot lock for any other reason. */
510 lock_if_free (clasher
, lfname
)
511 lock_info_type
*clasher
;
512 register char *lfname
;
514 while (lock_file_1 (lfname
, 0) == 0)
521 locker
= current_lock_owner (clasher
, lfname
);
524 FREE_LOCK_INFO (*clasher
);
525 return 0; /* We ourselves locked it. */
527 else if (locker
== 1)
528 return 1; /* Someone else has it. */
529 else if (locker
== -1)
530 return -1; /* current_lock_owner returned strange error. */
532 /* We deleted a stale lock; try again to lock the file. */
537 /* lock_file locks file FN,
538 meaning it serves notice on the world that you intend to edit that file.
539 This should be done only when about to modify a file-visiting
540 buffer previously unmodified.
541 Do not (normally) call this for a buffer already modified,
542 as either the file is already locked, or the user has already
543 decided to go ahead without locking.
545 When this returns, either the lock is locked for us,
546 or the user has said to go ahead without locking.
548 If the file is locked by someone else, this calls
549 ask-user-about-lock (a Lisp function) with two arguments,
550 the file name and info about the user who did the locking.
551 This function can signal an error, or return t meaning
552 take away the lock, or return nil meaning ignore the lock. */
558 register Lisp_Object attack
, orig_fn
, encoded_fn
;
559 register char *lfname
, *locker
;
560 lock_info_type lock_info
;
562 /* Don't do locking while dumping Emacs.
563 Uncompressing wtmp files uses call-process, which does not work
564 in an uninitialized Emacs. */
565 if (! NILP (Vpurify_flag
))
569 fn
= Fexpand_file_name (fn
, Qnil
);
570 encoded_fn
= ENCODE_FILE (fn
);
572 /* Create the name of the lock-file for file fn */
573 MAKE_LOCK_NAME (lfname
, encoded_fn
);
575 /* See if this file is visited and has changed on disk since it was
578 register Lisp_Object subject_buf
;
581 subject_buf
= get_truename_buffer (orig_fn
);
584 if (!NILP (subject_buf
)
585 && NILP (Fverify_visited_file_modtime (subject_buf
))
586 && !NILP (Ffile_exists_p (fn
)))
587 call1 (intern ("ask-user-about-supersession-threat"), fn
);
592 /* Try to lock the lock. */
593 if (lock_if_free (&lock_info
, lfname
) <= 0)
594 /* Return now if we have locked it, or if lock creation failed */
597 /* Else consider breaking the lock */
598 locker
= (char *) alloca (strlen (lock_info
.user
) + strlen (lock_info
.host
)
600 sprintf (locker
, "%s@%s (pid %lu)", lock_info
.user
, lock_info
.host
,
602 FREE_LOCK_INFO (lock_info
);
604 attack
= call2 (intern ("ask-user-about-lock"), fn
, build_string (locker
));
606 /* User says take the lock */
608 lock_file_1 (lfname
, 1);
611 /* User says ignore the lock */
616 register Lisp_Object fn
;
618 register char *lfname
;
620 fn
= Fexpand_file_name (fn
, Qnil
);
621 fn
= ENCODE_FILE (fn
);
623 MAKE_LOCK_NAME (lfname
, fn
);
625 if (current_lock_owner (0, lfname
) == 2)
632 register Lisp_Object tail
;
633 register struct buffer
*b
;
635 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
637 b
= XBUFFER (XCDR (XCAR (tail
)));
638 if (STRINGP (b
->file_truename
) && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
))
640 register char *lfname
;
642 MAKE_LOCK_NAME (lfname
, b
->file_truename
);
644 if (current_lock_owner (0, lfname
) == 2)
650 DEFUN ("lock-buffer", Flock_buffer
, Slock_buffer
,
652 "Lock FILE, if current buffer is modified.\n\
653 FILE defaults to current buffer's visited file,\n\
654 or else nothing is done if current buffer isn't visiting a file.")
659 file
= current_buffer
->file_truename
;
661 CHECK_STRING (file
, 0);
662 if (SAVE_MODIFF
< MODIFF
668 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
670 "Unlock the file visited in the current buffer,\n\
671 if it should normally be locked.")
674 if (SAVE_MODIFF
< MODIFF
675 && STRINGP (current_buffer
->file_truename
))
676 unlock_file (current_buffer
->file_truename
);
680 /* Unlock the file visited in buffer BUFFER. */
683 unlock_buffer (buffer
)
684 struct buffer
*buffer
;
686 if (BUF_SAVE_MODIFF (buffer
) < BUF_MODIFF (buffer
)
687 && STRINGP (buffer
->file_truename
))
688 unlock_file (buffer
->file_truename
);
691 DEFUN ("file-locked-p", Ffile_locked_p
, Sfile_locked_p
, 0, 1, 0,
692 "Return nil if the FILENAME is not locked,\n\
693 t if it is locked by you, else a string of the name of the locker.")
695 Lisp_Object filename
;
698 register char *lfname
;
700 lock_info_type locker
;
702 filename
= Fexpand_file_name (filename
, Qnil
);
704 MAKE_LOCK_NAME (lfname
, filename
);
706 owner
= current_lock_owner (&locker
, lfname
);
712 ret
= build_string (locker
.user
);
715 FREE_LOCK_INFO (locker
);
720 /* Initialization functions. */
726 boot_time_initialized
= 0;
732 DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory
,
733 "The directory for writing temporary files.");
734 Vtemporary_file_directory
= Qnil
;
736 defsubr (&Sunlock_buffer
);
737 defsubr (&Slock_buffer
);
738 defsubr (&Sfile_locked_p
);
741 #endif /* CLASH_DETECTION */