* ccl.c (CCL_CODE_RANGE): Allow negative numbers. (Bug#8751)
[emacs.git] / src / filelock.c
blob13b27c72f1921a992ec73d7c067846b30baa989d
1 /* Lock files for editing.
2 Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2011
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>
26 #include <setjmp.h>
28 #ifdef HAVE_PWD_H
29 #include <pwd.h>
30 #endif
32 #include <sys/file.h>
33 #include <fcntl.h>
34 #include <unistd.h>
36 #ifdef __FreeBSD__
37 #include <sys/sysctl.h>
38 #endif /* __FreeBSD__ */
40 #include <errno.h>
42 #include "lisp.h"
43 #include "buffer.h"
44 #include "character.h"
45 #include "coding.h"
46 #include "systime.h"
48 #ifdef CLASH_DETECTION
50 #ifdef HAVE_UTMP_H
51 #include <utmp.h>
52 #endif
54 /* A file whose last-modified time is just after the most recent boot.
55 Define this to be NULL to disable checking for this file. */
56 #ifndef BOOT_TIME_FILE
57 #define BOOT_TIME_FILE "/var/run/random-seed"
58 #endif
60 #ifndef WTMP_FILE
61 #define WTMP_FILE "/var/log/wtmp"
62 #endif
64 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
65 directory, with link data `user@host.pid'. This avoids a single
66 mount (== failure) point for lock files.
68 When the host in the lock data is the current host, we can check if
69 the pid is valid with kill.
71 Otherwise, we could look at a separate file that maps hostnames to
72 reboot times to see if the remote pid can possibly be valid, since we
73 don't want Emacs to have to communicate via pipes or sockets or
74 whatever to other processes, either locally or remotely; rms says
75 that's too unreliable. Hence the separate file, which could
76 theoretically be updated by daemons running separately -- but this
77 whole idea is unimplemented; in practice, at least in our
78 environment, it seems such stale locks arise fairly infrequently, and
79 Emacs' standard methods of dealing with clashes suffice.
81 We use symlinks instead of normal files because (1) they can be
82 stored more efficiently on the filesystem, since the kernel knows
83 they will be small, and (2) all the info about the lock can be read
84 in a single system call (readlink). Although we could use regular
85 files to be useful on old systems lacking symlinks, nowadays
86 virtually all such systems are probably single-user anyway, so it
87 didn't seem worth the complication.
89 Similarly, we don't worry about a possible 14-character limit on
90 file names, because those are all the same systems that don't have
91 symlinks.
93 This is compatible with the locking scheme used by Interleaf (which
94 has contributed this implementation for Emacs), and was designed by
95 Ethan Jacobson, Kimbo Mundy, and others.
97 --karl@cs.umb.edu/karl@hq.ileaf.com. */
100 /* Return the time of the last system boot. */
102 static time_t boot_time;
103 static int boot_time_initialized;
105 #ifdef BOOT_TIME
106 static void get_boot_time_1 (const char *, int);
107 #endif
109 static time_t
110 get_boot_time (void)
112 #if defined (BOOT_TIME)
113 int counter;
114 #endif
116 if (boot_time_initialized)
117 return boot_time;
118 boot_time_initialized = 1;
120 #if defined (CTL_KERN) && defined (KERN_BOOTTIME)
122 int mib[2];
123 size_t size;
124 struct timeval boottime_val;
126 mib[0] = CTL_KERN;
127 mib[1] = KERN_BOOTTIME;
128 size = sizeof (boottime_val);
130 if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
132 boot_time = boottime_val.tv_sec;
133 return boot_time;
136 #endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
138 if (BOOT_TIME_FILE)
140 struct stat st;
141 if (stat (BOOT_TIME_FILE, &st) == 0)
143 boot_time = st.st_mtime;
144 return boot_time;
148 #if defined (BOOT_TIME)
149 #ifndef CANNOT_DUMP
150 /* The utmp routines maintain static state.
151 Don't touch that state unless we are initialized,
152 since it might not survive dumping. */
153 if (! initialized)
154 return boot_time;
155 #endif /* not CANNOT_DUMP */
157 /* Try to get boot time from utmp before wtmp,
158 since utmp is typically much smaller than wtmp.
159 Passing a null pointer causes get_boot_time_1
160 to inspect the default file, namely utmp. */
161 get_boot_time_1 ((char *) 0, 0);
162 if (boot_time)
163 return boot_time;
165 /* Try to get boot time from the current wtmp file. */
166 get_boot_time_1 (WTMP_FILE, 1);
168 /* If we did not find a boot time in wtmp, look at wtmp, and so on. */
169 for (counter = 0; counter < 20 && ! boot_time; counter++)
171 char cmd_string[100];
172 Lisp_Object tempname, filename;
173 int delete_flag = 0;
175 filename = Qnil;
177 sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
178 tempname = build_string (cmd_string);
179 if (! NILP (Ffile_exists_p (tempname)))
180 filename = tempname;
181 else
183 sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
184 tempname = build_string (cmd_string);
185 if (! NILP (Ffile_exists_p (tempname)))
187 Lisp_Object args[6];
189 /* The utmp functions on mescaline.gnu.org accept only
190 file names up to 8 characters long. Choose a 2
191 character long prefix, and call make_temp_file with
192 second arg non-zero, so that it will add not more
193 than 6 characters to the prefix. */
194 tempname = Fexpand_file_name (build_string ("wt"),
195 Vtemporary_file_directory);
196 tempname = make_temp_name (tempname, 1);
197 args[0] = Vshell_file_name;
198 args[1] = Qnil;
199 args[2] = Qnil;
200 args[3] = Qnil;
201 args[4] = build_string ("-c");
202 sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
203 WTMP_FILE, counter, SDATA (tempname));
204 args[5] = build_string (cmd_string);
205 Fcall_process (6, args);
206 filename = tempname;
207 delete_flag = 1;
211 if (! NILP (filename))
213 get_boot_time_1 (SSDATA (filename), 1);
214 if (delete_flag)
215 unlink (SSDATA (filename));
219 return boot_time;
220 #else
221 return 0;
222 #endif
225 #ifdef BOOT_TIME
226 /* Try to get the boot time from wtmp file FILENAME.
227 This succeeds if that file contains a reboot record.
229 If FILENAME is zero, use the same file as before;
230 if no FILENAME has ever been specified, this is the utmp file.
231 Use the newest reboot record if NEWEST is nonzero,
232 the first reboot record otherwise.
233 Ignore all reboot records on or before BOOT_TIME.
234 Success is indicated by setting BOOT_TIME to a larger value. */
236 void
237 get_boot_time_1 (const char *filename, int newest)
239 struct utmp ut, *utp;
240 int desc;
242 if (filename)
244 /* On some versions of IRIX, opening a nonexistent file name
245 is likely to crash in the utmp routines. */
246 desc = emacs_open (filename, O_RDONLY, 0);
247 if (desc < 0)
248 return;
250 emacs_close (desc);
252 utmpname (filename);
255 setutent ();
257 while (1)
259 /* Find the next reboot record. */
260 ut.ut_type = BOOT_TIME;
261 utp = getutid (&ut);
262 if (! utp)
263 break;
264 /* Compare reboot times and use the newest one. */
265 if (utp->ut_time > boot_time)
267 boot_time = utp->ut_time;
268 if (! newest)
269 break;
271 /* Advance on element in the file
272 so that getutid won't repeat the same one. */
273 utp = getutent ();
274 if (! utp)
275 break;
277 endutent ();
279 #endif /* BOOT_TIME */
281 /* Here is the structure that stores information about a lock. */
283 typedef struct
285 char *user;
286 char *host;
287 unsigned long pid;
288 time_t boot_time;
289 } lock_info_type;
291 /* When we read the info back, we might need this much more,
292 enough for decimal representation plus null. */
293 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
295 /* Free the two dynamically-allocated pieces in PTR. */
296 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
299 /* Write the name of the lock file for FN into LFNAME. Length will be
300 that of FN plus two more for the leading `.#' plus 1 for the
301 trailing period plus one for the digit after it plus one for the
302 null. */
303 #define MAKE_LOCK_NAME(lock, file) \
304 (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
305 fill_in_lock_file_name (lock, (file)))
307 static void
308 fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
310 register char *p;
311 struct stat st;
312 int count = 0;
314 strcpy (lockfile, SSDATA (fn));
316 /* Shift the nondirectory part of the file name (including the null)
317 right two characters. Here is one of the places where we'd have to
318 do something to support 14-character-max file names. */
319 for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
320 p[2] = *p;
322 /* Insert the `.#'. */
323 p[1] = '.';
324 p[2] = '#';
326 p = p + strlen (p);
328 while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
330 if (count > 9)
332 *p = '\0';
333 return;
335 sprintf (p, ".%d", count++);
339 /* Lock the lock file named LFNAME.
340 If FORCE is nonzero, we do so even if it is already locked.
341 Return 1 if successful, 0 if not. */
343 static int
344 lock_file_1 (char *lfname, int force)
346 register int err;
347 time_t boot;
348 const char *user_name;
349 const char *host_name;
350 char *lock_info_str;
352 /* Call this first because it can GC. */
353 boot = get_boot_time ();
355 if (STRINGP (Fuser_login_name (Qnil)))
356 user_name = SSDATA (Fuser_login_name (Qnil));
357 else
358 user_name = "";
359 if (STRINGP (Fsystem_name ()))
360 host_name = SSDATA (Fsystem_name ());
361 else
362 host_name = "";
363 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
364 + LOCK_PID_MAX + 30);
366 if (boot)
367 sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name,
368 (unsigned long) getpid (), (unsigned long) boot);
369 else
370 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
371 (unsigned long) getpid ());
373 err = symlink (lock_info_str, lfname);
374 if (errno == EEXIST && force)
376 unlink (lfname);
377 err = symlink (lock_info_str, lfname);
380 return err == 0;
383 /* Return 1 if times A and B are no more than one second apart. */
385 static int
386 within_one_second (time_t a, time_t b)
388 return (a - b >= -1 && a - b <= 1);
391 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
392 1 if another process owns it (and set OWNER (if non-null) to info),
393 2 if the current process owns it,
394 or -1 if something is wrong with the locking mechanism. */
396 static int
397 current_lock_owner (lock_info_type *owner, char *lfname)
399 int ret;
400 size_t len;
401 int local_owner = 0;
402 char *at, *dot, *colon;
403 char readlink_buf[READLINK_BUFSIZE];
404 char *lfinfo = emacs_readlink (lfname, readlink_buf);
406 /* If nonexistent lock file, all is well; otherwise, got strange error. */
407 if (!lfinfo)
408 return errno == ENOENT ? 0 : -1;
410 /* Even if the caller doesn't want the owner info, we still have to
411 read it to determine return value, so allocate it. */
412 if (!owner)
414 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
415 local_owner = 1;
418 /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
419 /* The USER is everything before the last @. */
420 at = strrchr (lfinfo, '@');
421 dot = strrchr (lfinfo, '.');
422 if (!at || !dot)
424 if (lfinfo != readlink_buf)
425 xfree (lfinfo);
426 return -1;
428 len = at - lfinfo;
429 owner->user = (char *) xmalloc (len + 1);
430 strncpy (owner->user, lfinfo, len);
431 owner->user[len] = 0;
433 /* The PID is everything from the last `.' to the `:'. */
434 owner->pid = atoi (dot + 1);
435 colon = dot;
436 while (*colon && *colon != ':')
437 colon++;
438 /* After the `:', if there is one, comes the boot time. */
439 if (*colon == ':')
440 owner->boot_time = atoi (colon + 1);
441 else
442 owner->boot_time = 0;
444 /* The host is everything in between. */
445 len = dot - at - 1;
446 owner->host = (char *) xmalloc (len + 1);
447 strncpy (owner->host, at + 1, len);
448 owner->host[len] = 0;
450 /* We're done looking at the link info. */
451 if (lfinfo != readlink_buf)
452 xfree (lfinfo);
454 /* On current host? */
455 if (STRINGP (Fsystem_name ())
456 && strcmp (owner->host, SSDATA (Fsystem_name ())) == 0)
458 if (owner->pid == getpid ())
459 ret = 2; /* We own it. */
460 else if (owner->pid > 0
461 && (kill (owner->pid, 0) >= 0 || errno == EPERM)
462 && (owner->boot_time == 0
463 || within_one_second (owner->boot_time, get_boot_time ())))
464 ret = 1; /* An existing process on this machine owns it. */
465 /* The owner process is dead or has a strange pid (<=0), so try to
466 zap the lockfile. */
467 else if (unlink (lfname) < 0)
468 ret = -1;
469 else
470 ret = 0;
472 else
473 { /* If we wanted to support the check for stale locks on remote machines,
474 here's where we'd do it. */
475 ret = 1;
478 /* Avoid garbage. */
479 if (local_owner || ret <= 0)
481 FREE_LOCK_INFO (*owner);
483 return ret;
487 /* Lock the lock named LFNAME if possible.
488 Return 0 in that case.
489 Return positive if some other process owns the lock, and info about
490 that process in CLASHER.
491 Return -1 if cannot lock for any other reason. */
493 static int
494 lock_if_free (lock_info_type *clasher, register char *lfname)
496 while (lock_file_1 (lfname, 0) == 0)
498 int locker;
500 if (errno != EEXIST)
501 return -1;
503 locker = current_lock_owner (clasher, lfname);
504 if (locker == 2)
506 FREE_LOCK_INFO (*clasher);
507 return 0; /* We ourselves locked it. */
509 else if (locker == 1)
510 return 1; /* Someone else has it. */
511 else if (locker == -1)
512 return -1; /* current_lock_owner returned strange error. */
514 /* We deleted a stale lock; try again to lock the file. */
516 return 0;
519 /* lock_file locks file FN,
520 meaning it serves notice on the world that you intend to edit that file.
521 This should be done only when about to modify a file-visiting
522 buffer previously unmodified.
523 Do not (normally) call this for a buffer already modified,
524 as either the file is already locked, or the user has already
525 decided to go ahead without locking.
527 When this returns, either the lock is locked for us,
528 or the user has said to go ahead without locking.
530 If the file is locked by someone else, this calls
531 ask-user-about-lock (a Lisp function) with two arguments,
532 the file name and info about the user who did the locking.
533 This function can signal an error, or return t meaning
534 take away the lock, or return nil meaning ignore the lock. */
536 void
537 lock_file (Lisp_Object fn)
539 register Lisp_Object attack, orig_fn, encoded_fn;
540 register char *lfname, *locker;
541 lock_info_type lock_info;
542 struct gcpro gcpro1;
544 /* Don't do locking while dumping Emacs.
545 Uncompressing wtmp files uses call-process, which does not work
546 in an uninitialized Emacs. */
547 if (! NILP (Vpurify_flag))
548 return;
550 orig_fn = fn;
551 GCPRO1 (fn);
552 fn = Fexpand_file_name (fn, Qnil);
553 encoded_fn = ENCODE_FILE (fn);
555 /* Create the name of the lock-file for file fn */
556 MAKE_LOCK_NAME (lfname, encoded_fn);
558 /* See if this file is visited and has changed on disk since it was
559 visited. */
561 register Lisp_Object subject_buf;
563 subject_buf = get_truename_buffer (orig_fn);
565 if (!NILP (subject_buf)
566 && NILP (Fverify_visited_file_modtime (subject_buf))
567 && !NILP (Ffile_exists_p (fn)))
568 call1 (intern ("ask-user-about-supersession-threat"), fn);
571 UNGCPRO;
573 /* Try to lock the lock. */
574 if (lock_if_free (&lock_info, lfname) <= 0)
575 /* Return now if we have locked it, or if lock creation failed */
576 return;
578 /* Else consider breaking the lock */
579 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
580 + LOCK_PID_MAX + 9);
581 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
582 lock_info.pid);
583 FREE_LOCK_INFO (lock_info);
585 attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
586 if (!NILP (attack))
587 /* User says take the lock */
589 lock_file_1 (lfname, 1);
590 return;
592 /* User says ignore the lock */
595 void
596 unlock_file (register Lisp_Object fn)
598 register char *lfname;
600 fn = Fexpand_file_name (fn, Qnil);
601 fn = ENCODE_FILE (fn);
603 MAKE_LOCK_NAME (lfname, fn);
605 if (current_lock_owner (0, lfname) == 2)
606 unlink (lfname);
609 void
610 unlock_all_files (void)
612 register Lisp_Object tail;
613 register struct buffer *b;
615 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
617 b = XBUFFER (XCDR (XCAR (tail)));
618 if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
620 unlock_file(BVAR (b, file_truename));
625 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
626 0, 1, 0,
627 doc: /* Lock FILE, if current buffer is modified.
628 FILE defaults to current buffer's visited file,
629 or else nothing is done if current buffer isn't visiting a file. */)
630 (Lisp_Object file)
632 if (NILP (file))
633 file = BVAR (current_buffer, file_truename);
634 else
635 CHECK_STRING (file);
636 if (SAVE_MODIFF < MODIFF
637 && !NILP (file))
638 lock_file (file);
639 return Qnil;
642 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
643 0, 0, 0,
644 doc: /* Unlock the file visited in the current buffer.
645 If the buffer is not modified, this does nothing because the file
646 should not be locked in that case. */)
647 (void)
649 if (SAVE_MODIFF < MODIFF
650 && STRINGP (BVAR (current_buffer, file_truename)))
651 unlock_file (BVAR (current_buffer, file_truename));
652 return Qnil;
655 /* Unlock the file visited in buffer BUFFER. */
657 void
658 unlock_buffer (struct buffer *buffer)
660 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
661 && STRINGP (BVAR (buffer, file_truename)))
662 unlock_file (BVAR (buffer, file_truename));
665 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
666 doc: /* Return a value indicating whether FILENAME is locked.
667 The value is nil if the FILENAME is not locked,
668 t if it is locked by you, else a string saying which user has locked it. */)
669 (Lisp_Object filename)
671 Lisp_Object ret;
672 register char *lfname;
673 int owner;
674 lock_info_type locker;
676 filename = Fexpand_file_name (filename, Qnil);
678 MAKE_LOCK_NAME (lfname, filename);
680 owner = current_lock_owner (&locker, lfname);
681 if (owner <= 0)
682 ret = Qnil;
683 else if (owner == 2)
684 ret = Qt;
685 else
686 ret = build_string (locker.user);
688 if (owner > 0)
689 FREE_LOCK_INFO (locker);
691 return ret;
694 /* Initialization functions. */
696 void
697 init_filelock (void)
699 boot_time = 0;
700 boot_time_initialized = 0;
703 #endif /* CLASH_DETECTION */
705 void
706 syms_of_filelock (void)
708 DEFVAR_LISP ("temporary-file-directory", Vtemporary_file_directory,
709 doc: /* The directory for writing temporary files. */);
710 Vtemporary_file_directory = Qnil;
712 #ifdef CLASH_DETECTION
713 defsubr (&Sunlock_buffer);
714 defsubr (&Slock_buffer);
715 defsubr (&Sfile_locked_p);
716 #endif