*** empty log message ***
[emacs.git] / src / filelock.c
blob4ca356f337f0678f9d3dac327e7968f3eecb6306
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)
9 any later version.
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 <config.h>
23 #include <sys/types.h>
24 #include <sys/stat.h>
25 #include <signal.h>
26 #include <stdio.h>
28 #ifdef VMS
29 #include "vms-pwd.h"
30 #else
31 #include <pwd.h>
32 #endif /* not VMS */
34 #include <sys/file.h>
35 #ifdef HAVE_FCNTL_H
36 #include <fcntl.h>
37 #endif
38 #ifdef HAVE_STRING_H
39 #include <string.h>
40 #endif
42 #ifdef HAVE_UNISTD_H
43 #include <unistd.h>
44 #endif
46 #ifdef __FreeBSD__
47 #include <sys/sysctl.h>
48 #endif /* __FreeBSD__ */
50 #include <errno.h>
51 #ifndef errno
52 extern int errno;
53 #endif
55 #include "lisp.h"
56 #include "buffer.h"
57 #include "charset.h"
58 #include "coding.h"
59 #include "systime.h"
61 /* The directory for writing temporary files. */
63 Lisp_Object Vtemporary_file_directory;
65 #ifdef CLASH_DETECTION
67 #include <utmp.h>
69 /* A file whose last-modified time is just after the most recent boot.
70 Define this to be NULL to disable checking for this file. */
71 #ifndef BOOT_TIME_FILE
72 #define BOOT_TIME_FILE "/var/run/random-seed"
73 #endif
75 #ifndef WTMP_FILE
76 #define WTMP_FILE "/var/log/wtmp"
77 #endif
79 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
80 directory, with link data `user@host.pid'. This avoids a single
81 mount (== failure) point for lock files.
83 When the host in the lock data is the current host, we can check if
84 the pid is valid with kill.
86 Otherwise, we could look at a separate file that maps hostnames to
87 reboot times to see if the remote pid can possibly be valid, since we
88 don't want Emacs to have to communicate via pipes or sockets or
89 whatever to other processes, either locally or remotely; rms says
90 that's too unreliable. Hence the separate file, which could
91 theoretically be updated by daemons running separately -- but this
92 whole idea is unimplemented; in practice, at least in our
93 environment, it seems such stale locks arise fairly infrequently, and
94 Emacs' standard methods of dealing with clashes suffice.
96 We use symlinks instead of normal files because (1) they can be
97 stored more efficiently on the filesystem, since the kernel knows
98 they will be small, and (2) all the info about the lock can be read
99 in a single system call (readlink). Although we could use regular
100 files to be useful on old systems lacking symlinks, nowadays
101 virtually all such systems are probably single-user anyway, so it
102 didn't seem worth the complication.
104 Similarly, we don't worry about a possible 14-character limit on
105 file names, because those are all the same systems that don't have
106 symlinks.
108 This is compatible with the locking scheme used by Interleaf (which
109 has contributed this implementation for Emacs), and was designed by
110 Ethan Jacobson, Kimbo Mundy, and others.
112 --karl@cs.umb.edu/karl@hq.ileaf.com. */
115 /* Return the time of the last system boot. */
117 static time_t boot_time;
118 static int boot_time_initialized;
120 extern Lisp_Object Vshell_file_name;
122 #ifdef BOOT_TIME
123 static void get_boot_time_1 P_ ((char *, int));
124 #endif
126 static time_t
127 get_boot_time ()
129 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
130 int counter;
131 #endif
133 if (boot_time_initialized)
134 return boot_time;
135 boot_time_initialized = 1;
137 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
139 int mib[2];
140 size_t size;
141 struct timeval boottime_val;
143 mib[0] = CTL_KERN;
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;
150 return boot_time;
153 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
155 if (BOOT_TIME_FILE)
157 struct stat st;
158 if (stat (BOOT_TIME_FILE, &st) == 0)
160 boot_time = st.st_mtime;
161 return boot_time;
165 #if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
166 #ifndef CANNOT_DUMP
167 /* The utmp routines maintain static state.
168 Don't touch that state unless we are initialized,
169 since it might not survive dumping. */
170 if (! initialized)
171 return boot_time;
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);
179 if (boot_time)
180 return boot_time;
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;
190 int delete_flag = 0;
192 filename = Qnil;
194 sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
195 tempname = build_string (cmd_string);
196 if (! NILP (Ffile_exists_p (tempname)))
197 filename = tempname;
198 else
200 sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
201 tempname = build_string (cmd_string);
202 if (! NILP (Ffile_exists_p (tempname)))
204 Lisp_Object args[6];
206 /* The utmp functions on mescaline.gnu.org accept only
207 file names up to 8 characters long. Choose a 2
208 character long prefix, and call make_temp_file with
209 second arg non-zero, so that it will add not more
210 than 6 characters to the prefix. */
211 tempname = Fexpand_file_name (build_string ("wt"),
212 Vtemporary_file_directory);
213 tempname = make_temp_name (tempname, 1);
214 args[0] = Vshell_file_name;
215 args[1] = Qnil;
216 args[2] = Qnil;
217 args[3] = Qnil;
218 args[4] = build_string ("-c");
219 sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
220 WTMP_FILE, counter, XSTRING (tempname)->data);
221 args[5] = build_string (cmd_string);
222 Fcall_process (6, args);
223 filename = tempname;
224 delete_flag = 1;
228 if (! NILP (filename))
230 get_boot_time_1 (XSTRING (filename)->data, 1);
231 if (delete_flag)
232 unlink (XSTRING (filename)->data);
236 return boot_time;
237 #else
238 return 0;
239 #endif
242 #ifdef BOOT_TIME
243 /* Try to get the boot time from wtmp file FILENAME.
244 This succeeds if that file contains a reboot record.
246 If FILENAME is zero, use the same file as before;
247 if no FILENAME has ever been specified, this is the utmp file.
248 Use the newest reboot record if NEWEST is nonzero,
249 the first reboot record otherwise.
250 Ignore all reboot records on or before BOOT_TIME.
251 Success is indicated by setting BOOT_TIME to a larger value. */
253 void
254 get_boot_time_1 (filename, newest)
255 char *filename;
256 int newest;
258 struct utmp ut, *utp;
259 int desc;
261 if (filename)
263 /* On some versions of IRIX, opening a nonexistent file name
264 is likely to crash in the utmp routines. */
265 desc = emacs_open (filename, O_RDONLY, 0);
266 if (desc < 0)
267 return;
269 emacs_close (desc);
271 utmpname (filename);
274 setutent ();
276 while (1)
278 /* Find the next reboot record. */
279 ut.ut_type = BOOT_TIME;
280 utp = getutid (&ut);
281 if (! utp)
282 break;
283 /* Compare reboot times and use the newest one. */
284 if (utp->ut_time > boot_time)
286 boot_time = utp->ut_time;
287 if (! newest)
288 break;
290 /* Advance on element in the file
291 so that getutid won't repeat the same one. */
292 utp = getutent ();
293 if (! utp)
294 break;
296 endutent ();
298 #endif /* BOOT_TIME */
300 /* Here is the structure that stores information about a lock. */
302 typedef struct
304 char *user;
305 char *host;
306 unsigned long pid;
307 time_t boot_time;
308 } lock_info_type;
310 /* When we read the info back, we might need this much more,
311 enough for decimal representation plus null. */
312 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
314 /* Free the two dynamically-allocated pieces in PTR. */
315 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
318 /* Write the name of the lock file for FN into LFNAME. Length will be
319 that of FN plus two more for the leading `.#' plus 1 for the
320 trailing period plus one for the digit after it plus one for the
321 null. */
322 #define MAKE_LOCK_NAME(lock, file) \
323 (lock = (char *) alloca (STRING_BYTES (XSTRING (file)) + 2 + 1 + 1 + 1), \
324 fill_in_lock_file_name (lock, (file)))
326 static void
327 fill_in_lock_file_name (lockfile, fn)
328 register char *lockfile;
329 register Lisp_Object fn;
331 register char *p;
332 struct stat st;
333 int count = 0;
335 strcpy (lockfile, XSTRING (fn)->data);
337 /* Shift the nondirectory part of the file name (including the null)
338 right two characters. Here is one of the places where we'd have to
339 do something to support 14-character-max file names. */
340 for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
341 p[2] = *p;
343 /* Insert the `.#'. */
344 p[1] = '.';
345 p[2] = '#';
347 p = p + strlen (p);
349 while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
351 if (count > 9)
353 *p = '\0';
354 return;
356 sprintf (p, ".%d", count++);
360 /* Lock the lock file named LFNAME.
361 If FORCE is nonzero, we do so even if it is already locked.
362 Return 1 if successful, 0 if not. */
364 static int
365 lock_file_1 (lfname, force)
366 char *lfname;
367 int force;
369 register int err;
370 time_t boot_time;
371 char *user_name;
372 char *host_name;
373 char *lock_info_str;
375 if (STRINGP (Fuser_login_name (Qnil)))
376 user_name = (char *)XSTRING (Fuser_login_name (Qnil))->data;
377 else
378 user_name = "";
379 if (STRINGP (Fsystem_name ()))
380 host_name = (char *)XSTRING (Fsystem_name ())->data;
381 else
382 host_name = "";
383 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
384 + LOCK_PID_MAX + 5);
386 boot_time = get_boot_time ();
387 if (boot_time)
388 sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name,
389 (unsigned long) getpid (), (unsigned long) boot_time);
390 else
391 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
392 (unsigned long) getpid ());
394 err = symlink (lock_info_str, lfname);
395 if (errno == EEXIST && force)
397 unlink (lfname);
398 err = symlink (lock_info_str, lfname);
401 return err == 0;
404 /* Return 1 if times A and B are no more than one second apart. */
407 within_one_second (a, b)
408 time_t a, b;
410 return (a - b >= -1 && a - b <= 1);
413 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
414 1 if another process owns it (and set OWNER (if non-null) to info),
415 2 if the current process owns it,
416 or -1 if something is wrong with the locking mechanism. */
418 static int
419 current_lock_owner (owner, lfname)
420 lock_info_type *owner;
421 char *lfname;
423 #ifndef index
424 extern char *rindex (), *index ();
425 #endif
426 int len, ret;
427 int local_owner = 0;
428 char *at, *dot, *colon;
429 char *lfinfo = 0;
430 int bufsize = 50;
431 /* Read arbitrarily-long contents of symlink. Similar code in
432 file-symlink-p in fileio.c. */
435 bufsize *= 2;
436 lfinfo = (char *) xrealloc (lfinfo, bufsize);
437 len = readlink (lfname, lfinfo, bufsize);
439 while (len >= bufsize);
441 /* If nonexistent lock file, all is well; otherwise, got strange error. */
442 if (len == -1)
444 xfree (lfinfo);
445 return errno == ENOENT ? 0 : -1;
448 /* Link info exists, so `len' is its length. Null terminate. */
449 lfinfo[len] = 0;
451 /* Even if the caller doesn't want the owner info, we still have to
452 read it to determine return value, so allocate it. */
453 if (!owner)
455 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
456 local_owner = 1;
459 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
460 /* The USER is everything before the first @. */
461 at = index (lfinfo, '@');
462 dot = rindex (lfinfo, '.');
463 if (!at || !dot)
465 xfree (lfinfo);
466 return -1;
468 len = at - lfinfo;
469 owner->user = (char *) xmalloc (len + 1);
470 strncpy (owner->user, lfinfo, len);
471 owner->user[len] = 0;
473 /* The PID is everything from the last `.' to the `:'. */
474 owner->pid = atoi (dot + 1);
475 colon = dot;
476 while (*colon && *colon != ':')
477 colon++;
478 /* After the `:', if there is one, comes the boot time. */
479 if (*colon == ':')
480 owner->boot_time = atoi (colon + 1);
481 else
482 owner->boot_time = 0;
484 /* The host is everything in between. */
485 len = dot - at - 1;
486 owner->host = (char *) xmalloc (len + 1);
487 strncpy (owner->host, at + 1, len);
488 owner->host[len] = 0;
490 /* We're done looking at the link info. */
491 xfree (lfinfo);
493 /* On current host? */
494 if (STRINGP (Fsystem_name ())
495 && strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
497 if (owner->pid == getpid ())
498 ret = 2; /* We own it. */
499 else if (owner->pid > 0
500 && (kill (owner->pid, 0) >= 0 || errno == EPERM)
501 && (owner->boot_time == 0
502 || within_one_second (owner->boot_time, get_boot_time ())))
503 ret = 1; /* An existing process on this machine owns it. */
504 /* The owner process is dead or has a strange pid (<=0), so try to
505 zap the lockfile. */
506 else if (unlink (lfname) < 0)
507 ret = -1;
508 else
509 ret = 0;
511 else
512 { /* If we wanted to support the check for stale locks on remote machines,
513 here's where we'd do it. */
514 ret = 1;
517 /* Avoid garbage. */
518 if (local_owner || ret <= 0)
520 FREE_LOCK_INFO (*owner);
522 return ret;
526 /* Lock the lock named LFNAME if possible.
527 Return 0 in that case.
528 Return positive if some other process owns the lock, and info about
529 that process in CLASHER.
530 Return -1 if cannot lock for any other reason. */
532 static int
533 lock_if_free (clasher, lfname)
534 lock_info_type *clasher;
535 register char *lfname;
537 while (lock_file_1 (lfname, 0) == 0)
539 int locker;
541 if (errno != EEXIST)
542 return -1;
544 locker = current_lock_owner (clasher, lfname);
545 if (locker == 2)
547 FREE_LOCK_INFO (*clasher);
548 return 0; /* We ourselves locked it. */
550 else if (locker == 1)
551 return 1; /* Someone else has it. */
552 else if (locker == -1)
553 return -1; /* current_lock_owner returned strange error. */
555 /* We deleted a stale lock; try again to lock the file. */
557 return 0;
560 /* lock_file locks file FN,
561 meaning it serves notice on the world that you intend to edit that file.
562 This should be done only when about to modify a file-visiting
563 buffer previously unmodified.
564 Do not (normally) call this for a buffer already modified,
565 as either the file is already locked, or the user has already
566 decided to go ahead without locking.
568 When this returns, either the lock is locked for us,
569 or the user has said to go ahead without locking.
571 If the file is locked by someone else, this calls
572 ask-user-about-lock (a Lisp function) with two arguments,
573 the file name and info about the user who did the locking.
574 This function can signal an error, or return t meaning
575 take away the lock, or return nil meaning ignore the lock. */
577 void
578 lock_file (fn)
579 Lisp_Object fn;
581 register Lisp_Object attack, orig_fn, encoded_fn;
582 register char *lfname, *locker;
583 lock_info_type lock_info;
584 struct gcpro gcpro1;
586 /* Don't do locking while dumping Emacs.
587 Uncompressing wtmp files uses call-process, which does not work
588 in an uninitialized Emacs. */
589 if (! NILP (Vpurify_flag))
590 return;
592 orig_fn = fn;
593 GCPRO1 (fn);
594 fn = Fexpand_file_name (fn, Qnil);
595 encoded_fn = ENCODE_FILE (fn);
597 /* Create the name of the lock-file for file fn */
598 MAKE_LOCK_NAME (lfname, encoded_fn);
600 /* See if this file is visited and has changed on disk since it was
601 visited. */
603 register Lisp_Object subject_buf;
605 subject_buf = get_truename_buffer (orig_fn);
607 if (!NILP (subject_buf)
608 && NILP (Fverify_visited_file_modtime (subject_buf))
609 && !NILP (Ffile_exists_p (fn)))
610 call1 (intern ("ask-user-about-supersession-threat"), fn);
613 UNGCPRO;
615 /* Try to lock the lock. */
616 if (lock_if_free (&lock_info, lfname) <= 0)
617 /* Return now if we have locked it, or if lock creation failed */
618 return;
620 /* Else consider breaking the lock */
621 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
622 + LOCK_PID_MAX + 9);
623 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
624 lock_info.pid);
625 FREE_LOCK_INFO (lock_info);
627 attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
628 if (!NILP (attack))
629 /* User says take the lock */
631 lock_file_1 (lfname, 1);
632 return;
634 /* User says ignore the lock */
637 void
638 unlock_file (fn)
639 register Lisp_Object fn;
641 register char *lfname;
643 fn = Fexpand_file_name (fn, Qnil);
644 fn = ENCODE_FILE (fn);
646 MAKE_LOCK_NAME (lfname, fn);
648 if (current_lock_owner (0, lfname) == 2)
649 unlink (lfname);
652 void
653 unlock_all_files ()
655 register Lisp_Object tail;
656 register struct buffer *b;
658 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
660 b = XBUFFER (XCDR (XCAR (tail)));
661 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
663 register char *lfname;
665 MAKE_LOCK_NAME (lfname, b->file_truename);
667 if (current_lock_owner (0, lfname) == 2)
668 unlink (lfname);
673 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
674 0, 1, 0,
675 "Lock FILE, if current buffer is modified.\n\
676 FILE defaults to current buffer's visited file,\n\
677 or else nothing is done if current buffer isn't visiting a file.")
678 (file)
679 Lisp_Object file;
681 if (NILP (file))
682 file = current_buffer->file_truename;
683 else
684 CHECK_STRING (file, 0);
685 if (SAVE_MODIFF < MODIFF
686 && !NILP (file))
687 lock_file (file);
688 return Qnil;
691 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
692 0, 0, 0,
693 "Unlock the file visited in the current buffer,\n\
694 if it should normally be locked.")
697 if (SAVE_MODIFF < MODIFF
698 && STRINGP (current_buffer->file_truename))
699 unlock_file (current_buffer->file_truename);
700 return Qnil;
703 /* Unlock the file visited in buffer BUFFER. */
705 void
706 unlock_buffer (buffer)
707 struct buffer *buffer;
709 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
710 && STRINGP (buffer->file_truename))
711 unlock_file (buffer->file_truename);
714 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
715 "Return nil if the FILENAME is not locked,\n\
716 t if it is locked by you, else a string of the name of the locker.")
717 (filename)
718 Lisp_Object filename;
720 Lisp_Object ret;
721 register char *lfname;
722 int owner;
723 lock_info_type locker;
725 filename = Fexpand_file_name (filename, Qnil);
727 MAKE_LOCK_NAME (lfname, filename);
729 owner = current_lock_owner (&locker, lfname);
730 if (owner <= 0)
731 ret = Qnil;
732 else if (owner == 2)
733 ret = Qt;
734 else
735 ret = build_string (locker.user);
737 if (owner > 0)
738 FREE_LOCK_INFO (locker);
740 return ret;
743 /* Initialization functions. */
745 void
746 init_filelock ()
748 boot_time = 0;
749 boot_time_initialized = 0;
752 void
753 syms_of_filelock ()
755 DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory,
756 "The directory for writing temporary files.");
757 Vtemporary_file_directory = Qnil;
759 defsubr (&Sunlock_buffer);
760 defsubr (&Slock_buffer);
761 defsubr (&Sfile_locked_p);
764 #endif /* CLASH_DETECTION */