1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
3 This file is part of GNU Emacs.
5 GNU Emacs is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
10 GNU Emacs is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with GNU Emacs; see the file COPYING. If not, write to
17 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 Boston, MA 02111-1307, USA. */
20 /* Synced with FSF 20.2 */
31 #include "syssignal.h" /* for kill */
33 Lisp_Object Qask_user_about_supersession_threat;
34 Lisp_Object Qask_user_about_lock;
35 int inhibit_clash_detection;
37 #ifdef CLASH_DETECTION
39 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
40 directory, with link data `user@host.pid'. This avoids a single
41 mount (== failure) point for lock files.
43 When the host in the lock data is the current host, we can check if
44 the pid is valid with kill.
46 Otherwise, we could look at a separate file that maps hostnames to
47 reboot times to see if the remote pid can possibly be valid, since we
48 don't want Emacs to have to communicate via pipes or sockets or
49 whatever to other processes, either locally or remotely; rms says
50 that's too unreliable. Hence the separate file, which could
51 theoretically be updated by daemons running separately -- but this
52 whole idea is unimplemented; in practice, at least in our
53 environment, it seems such stale locks arise fairly infrequently, and
54 Emacs' standard methods of dealing with clashes suffice.
56 We use symlinks instead of normal files because (1) they can be
57 stored more efficiently on the filesystem, since the kernel knows
58 they will be small, and (2) all the info about the lock can be read
59 in a single system call (readlink). Although we could use regular
60 files to be useful on old systems lacking symlinks, nowadays
61 virtually all such systems are probably single-user anyway, so it
62 didn't seem worth the complication.
64 Similarly, we don't worry about a possible 14-character limit on
65 file names, because those are all the same systems that don't have
68 This is compatible with the locking scheme used by Interleaf (which
69 has contributed this implementation for Emacs), and was designed by
70 Ethan Jacobson, Kimbo Mundy, and others.
72 --karl@cs.umb.edu/karl@hq.ileaf.com. */
74 /* Note that muleization is provided by using mule-encapsulated
75 versions of the system calls we use like symlink(), unlink(), etc... */
78 /* Here is the structure that stores information about a lock. */
87 /* When we read the info back, we might need this much more,
88 enough for decimal representation plus null. */
89 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
91 /* Free the two dynamically-allocated pieces in PTR. */
92 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
94 /* Write the name of the lock file for FN into LFNAME. Length will be
95 that of FN plus two more for the leading `.#' plus one for the null. */
96 #define MAKE_LOCK_NAME(lock, file) \
97 (lock = (char *) alloca (XSTRING_LENGTH (file) + 2 + 1), \
98 fill_in_lock_file_name ((Bufbyte *) (lock), (file)))
101 fill_in_lock_file_name (Bufbyte *lockfile, Lisp_Object fn)
103 Bufbyte *file_name = XSTRING_DATA (fn);
107 for (p = file_name + XSTRING_LENGTH (fn) - 1;
108 p > file_name && !IS_ANY_SEP (p[-1]);
111 dirlen = p - file_name;
113 memcpy (lockfile, file_name, dirlen);
114 p = lockfile + dirlen;
117 memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen + 1);
120 /* Lock the lock file named LFNAME.
121 If FORCE is nonzero, we do so even if it is already locked.
122 Return 1 if successful, 0 if not. */
125 lock_file_1 (char *lfname, int force)
131 char *user_name = user_login_name (NULL);
133 if (user_name == NULL)
136 if (STRINGP (Vsystem_name))
137 host_name = (char *) XSTRING_DATA (Vsystem_name);
141 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
144 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
145 (unsigned long) getpid ());
147 err = symlink (lock_info_str, lfname);
148 if (err != 0 && errno == EEXIST && force)
151 err = symlink (lock_info_str, lfname);
157 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
158 1 if another process owns it (and set OWNER (if non-null) to info),
159 2 if the current process owns it,
160 or -1 if something is wrong with the locking mechanism. */
163 current_lock_owner (lock_info_type *owner, char *lfname)
171 /* Read arbitrarily-long contents of symlink. Similar code in
172 file-symlink-p in fileio.c. */
176 lfinfo = (char *) xrealloc (lfinfo, bufsize);
177 len = readlink (lfname, lfinfo, bufsize);
179 while (len >= bufsize);
181 /* If nonexistent lock file, all is well; otherwise, got strange error. */
185 return errno == ENOENT ? 0 : -1;
188 /* Link info exists, so `len' is its length. Null terminate. */
191 /* Even if the caller doesn't want the owner info, we still have to
192 read it to determine return value, so allocate it. */
195 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
199 /* Parse USER@HOST.PID. If can't parse, return -1. */
200 /* The USER is everything before the first @. */
201 at = strchr (lfinfo, '@');
202 dot = strrchr (lfinfo, '.');
208 owner->user = (char *) xmalloc (len + 1);
209 strncpy (owner->user, lfinfo, len);
210 owner->user[len] = 0;
212 /* The PID is everything after the last `.'. */
213 owner->pid = atoi (dot + 1);
215 /* The host is everything in between. */
217 owner->host = (char *) xmalloc (len + 1);
218 strncpy (owner->host, at + 1, len);
219 owner->host[len] = 0;
221 /* We're done looking at the link info. */
224 /* On current host? */
225 if (STRINGP (Fsystem_name ())
226 && strcmp (owner->host, (char *) XSTRING_DATA (Fsystem_name ())) == 0)
228 if (owner->pid == (unsigned long) getpid ())
229 ret = 2; /* We own it. */
230 else if (owner->pid > 0
231 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
232 ret = 1; /* An existing process on this machine owns it. */
233 /* The owner process is dead or has a strange pid (<=0), so try to
235 else if (unlink (lfname) < 0)
241 { /* If we wanted to support the check for stale locks on remote machines,
242 here's where we'd do it. */
247 if (local_owner || ret <= 0)
249 FREE_LOCK_INFO (*owner);
254 /* Lock the lock named LFNAME if possible.
255 Return 0 in that case.
256 Return positive if some other process owns the lock, and info about
257 that process in CLASHER.
258 Return -1 if cannot lock for any other reason. */
261 lock_if_free (lock_info_type *clasher, char *lfname)
264 if (lock_file_1 (lfname, 0) == 0)
271 locker = current_lock_owner (clasher, lfname);
274 FREE_LOCK_INFO (*clasher);
275 return 0; /* We ourselves locked it. */
277 else if (locker == 1)
278 return 1; /* Someone else has it. */
280 return -1; /* Something's wrong. */
285 /* lock_file locks file FN,
286 meaning it serves notice on the world that you intend to edit that file.
287 This should be done only when about to modify a file-visiting
288 buffer previously unmodified.
289 Do not (normally) call this for a buffer already modified,
290 as either the file is already locked, or the user has already
291 decided to go ahead without locking.
293 When this returns, either the lock is locked for us,
294 or the user has said to go ahead without locking.
296 If the file is locked by someone else, this calls
297 ask-user-about-lock (a Lisp function) with two arguments,
298 the file name and info about the user who did the locking.
299 This function can signal an error, or return t meaning
300 take away the lock, or return nil meaning ignore the lock. */
303 lock_file (Lisp_Object fn)
305 /* This function can GC. GC checked 7-11-00 ben */
306 /* dmoore - and can destroy current_buffer and all sorts of other
307 mean nasty things with pointy teeth. If you call this make sure
308 you protect things right. */
309 /* Somebody updated the code in this function and removed the previous
312 register Lisp_Object attack, orig_fn;
313 register char *lfname, *locker;
314 lock_info_type lock_info;
315 struct gcpro gcpro1, gcpro2, gcpro3;
316 Lisp_Object old_current_buffer;
317 Lisp_Object subject_buf;
319 if (inhibit_clash_detection)
322 XSETBUFFER (old_current_buffer, current_buffer);
324 GCPRO3 (fn, subject_buf, old_current_buffer);
326 fn = Fexpand_file_name (fn, Qnil);
328 /* Create the name of the lock-file for file fn */
329 MAKE_LOCK_NAME (lfname, fn);
331 /* See if this file is visited and has changed on disk since it was
334 subject_buf = get_truename_buffer (orig_fn);
335 if (!NILP (subject_buf)
336 && NILP (Fverify_visited_file_modtime (subject_buf))
337 && !NILP (Ffile_exists_p (fn)))
338 call1_in_buffer (XBUFFER (subject_buf),
339 Qask_user_about_supersession_threat, fn);
342 /* Try to lock the lock. */
343 if (current_buffer != XBUFFER (old_current_buffer)
344 || lock_if_free (&lock_info, lfname) <= 0)
345 /* Return now if we have locked it, or if lock creation failed
346 or current buffer is killed. */
349 /* Else consider breaking the lock */
350 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
352 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
354 FREE_LOCK_INFO (lock_info);
356 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
357 current_buffer, Qask_user_about_lock , fn,
358 build_string (locker));
359 if (!NILP (attack) && current_buffer == XBUFFER (old_current_buffer))
360 /* User says take the lock */
362 lock_file_1 (lfname, 1);
365 /* User says ignore the lock */
371 unlock_file (Lisp_Object fn)
374 register char *lfname;
379 fn = Fexpand_file_name (fn, Qnil);
381 MAKE_LOCK_NAME (lfname, fn);
383 if (current_lock_owner (0, lfname) == 2)
390 unlock_all_files (void)
392 register Lisp_Object tail;
394 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
396 struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
397 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
398 unlock_file (b->file_truename);
402 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
403 Lock FILE, if current buffer is modified.
404 FILE defaults to current buffer's visited file,
405 or else nothing is done if current buffer isn't visiting a file.
410 file = current_buffer->file_truename;
412 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
418 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
419 Unlock the file visited in the current buffer,
420 if it should normally be locked.
424 /* This function can GC */
425 /* dmoore - and can destroy current_buffer and all sorts of other
426 mean nasty things with pointy teeth. If you call this make sure
427 you protect things right. */
429 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
430 && STRINGP (current_buffer->file_truename))
431 unlock_file (current_buffer->file_truename);
435 /* Unlock the file visited in buffer BUFFER. */
439 unlock_buffer (struct buffer *buffer)
441 /* This function can GC */
442 /* dmoore - and can destroy current_buffer and all sorts of other
443 mean nasty things with pointy teeth. If you call this make sure
444 you protect things right. */
445 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
446 && STRINGP (buffer->file_truename))
447 unlock_file (buffer->file_truename);
450 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
451 Return nil if the FILENAME is not locked,
452 t if it is locked by you, else a string of the name of the locker.
457 register char *lfname;
459 lock_info_type locker;
464 filename = Fexpand_file_name (filename, Qnil);
466 MAKE_LOCK_NAME (lfname, filename);
468 owner = current_lock_owner (&locker, lfname);
474 ret = build_string (locker.user);
477 FREE_LOCK_INFO (locker);
485 /* Initialization functions. */
488 syms_of_filelock (void)
490 /* This function can GC */
491 DEFSUBR (Funlock_buffer);
492 DEFSUBR (Flock_buffer);
493 DEFSUBR (Ffile_locked_p);
495 defsymbol (&Qask_user_about_supersession_threat,
496 "ask-user-about-supersession-threat");
497 defsymbol (&Qask_user_about_lock, "ask-user-about-lock");
501 vars_of_filelock (void)
503 DEFVAR_BOOL ("inhibit-clash-detection", &inhibit_clash_detection /*
504 Non-nil inhibits creation of lock file to detect clash.
506 inhibit_clash_detection = 0;
509 #endif /* CLASH_DETECTION */