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;
36 #ifdef CLASH_DETECTION
38 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
39 directory, with link data `user@host.pid'. This avoids a single
40 mount (== failure) point for lock files.
42 When the host in the lock data is the current host, we can check if
43 the pid is valid with kill.
45 Otherwise, we could look at a separate file that maps hostnames to
46 reboot times to see if the remote pid can possibly be valid, since we
47 don't want Emacs to have to communicate via pipes or sockets or
48 whatever to other processes, either locally or remotely; rms says
49 that's too unreliable. Hence the separate file, which could
50 theoretically be updated by daemons running separately -- but this
51 whole idea is unimplemented; in practice, at least in our
52 environment, it seems such stale locks arise fairly infrequently, and
53 Emacs' standard methods of dealing with clashes suffice.
55 We use symlinks instead of normal files because (1) they can be
56 stored more efficiently on the filesystem, since the kernel knows
57 they will be small, and (2) all the info about the lock can be read
58 in a single system call (readlink). Although we could use regular
59 files to be useful on old systems lacking symlinks, nowadays
60 virtually all such systems are probably single-user anyway, so it
61 didn't seem worth the complication.
63 Similarly, we don't worry about a possible 14-character limit on
64 file names, because those are all the same systems that don't have
67 This is compatible with the locking scheme used by Interleaf (which
68 has contributed this implementation for Emacs), and was designed by
69 Ethan Jacobson, Kimbo Mundy, and others.
71 --karl@cs.umb.edu/karl@hq.ileaf.com. */
73 /* Note that muleization is provided by using mule-encapsulated
74 versions of the system calls we use like symlink(), unlink(), etc... */
77 /* Here is the structure that stores information about a lock. */
86 /* When we read the info back, we might need this much more,
87 enough for decimal representation plus null. */
88 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
90 /* Free the two dynamically-allocated pieces in PTR. */
91 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
93 /* Write the name of the lock file for FN into LFNAME. Length will be
94 that of FN plus two more for the leading `.#' plus one for the null. */
95 #define MAKE_LOCK_NAME(lock, file) \
96 (lock = (char *) alloca (XSTRING_LENGTH (file) + 2 + 1), \
97 fill_in_lock_file_name ((Bufbyte *) (lock), (file)))
100 fill_in_lock_file_name (Bufbyte *lockfile, Lisp_Object fn)
102 Bufbyte *file_name = XSTRING_DATA (fn);
106 for (p = file_name + XSTRING_LENGTH (fn) - 1;
107 p > file_name && !IS_ANY_SEP (p[-1]);
110 dirlen = p - file_name;
112 memcpy (lockfile, file_name, dirlen);
113 p = lockfile + dirlen;
116 memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen + 1);
119 /* Lock the lock file named LFNAME.
120 If FORCE is nonzero, we do so even if it is already locked.
121 Return 1 if successful, 0 if not. */
124 lock_file_1 (char *lfname, int force)
130 char *user_name = user_login_name (NULL);
132 if (user_name == NULL)
135 if (STRINGP (Vsystem_name))
136 host_name = (char *) XSTRING_DATA (Vsystem_name);
140 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
143 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
144 (unsigned long) getpid ());
146 err = symlink (lock_info_str, lfname);
147 if (err != 0 && errno == EEXIST && force)
150 err = symlink (lock_info_str, lfname);
156 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
157 1 if another process owns it (and set OWNER (if non-null) to info),
158 2 if the current process owns it,
159 or -1 if something is wrong with the locking mechanism. */
162 current_lock_owner (lock_info_type *owner, char *lfname)
170 /* Read arbitrarily-long contents of symlink. Similar code in
171 file-symlink-p in fileio.c. */
175 lfinfo = (char *) xrealloc (lfinfo, bufsize);
176 len = readlink (lfname, lfinfo, bufsize);
178 while (len >= bufsize);
180 /* If nonexistent lock file, all is well; otherwise, got strange error. */
184 return errno == ENOENT ? 0 : -1;
187 /* Link info exists, so `len' is its length. Null terminate. */
190 /* Even if the caller doesn't want the owner info, we still have to
191 read it to determine return value, so allocate it. */
194 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
198 /* Parse USER@HOST.PID. If can't parse, return -1. */
199 /* The USER is everything before the first @. */
200 at = strchr (lfinfo, '@');
201 dot = strrchr (lfinfo, '.');
207 owner->user = (char *) xmalloc (len + 1);
208 strncpy (owner->user, lfinfo, len);
209 owner->user[len] = 0;
211 /* The PID is everything after the last `.'. */
212 owner->pid = atoi (dot + 1);
214 /* The host is everything in between. */
216 owner->host = (char *) xmalloc (len + 1);
217 strncpy (owner->host, at + 1, len);
218 owner->host[len] = 0;
220 /* We're done looking at the link info. */
223 /* On current host? */
224 if (STRINGP (Fsystem_name ())
225 && strcmp (owner->host, (char *) XSTRING_DATA (Fsystem_name ())) == 0)
227 if (owner->pid == getpid ())
228 ret = 2; /* We own it. */
229 else if (owner->pid > 0
230 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
231 ret = 1; /* An existing process on this machine owns it. */
232 /* The owner process is dead or has a strange pid (<=0), so try to
234 else if (unlink (lfname) < 0)
240 { /* If we wanted to support the check for stale locks on remote machines,
241 here's where we'd do it. */
246 if (local_owner || ret <= 0)
248 FREE_LOCK_INFO (*owner);
253 /* Lock the lock named LFNAME if possible.
254 Return 0 in that case.
255 Return positive if some other process owns the lock, and info about
256 that process in CLASHER.
257 Return -1 if cannot lock for any other reason. */
260 lock_if_free (lock_info_type *clasher, char *lfname)
263 if (lock_file_1 (lfname, 0) == 0)
270 locker = current_lock_owner (clasher, lfname);
273 FREE_LOCK_INFO (*clasher);
274 return 0; /* We ourselves locked it. */
276 else if (locker == 1)
277 return 1; /* Someone else has it. */
279 return -1; /* Something's wrong. */
284 /* lock_file locks file FN,
285 meaning it serves notice on the world that you intend to edit that file.
286 This should be done only when about to modify a file-visiting
287 buffer previously unmodified.
288 Do not (normally) call this for a buffer already modified,
289 as either the file is already locked, or the user has already
290 decided to go ahead without locking.
292 When this returns, either the lock is locked for us,
293 or the user has said to go ahead without locking.
295 If the file is locked by someone else, this calls
296 ask-user-about-lock (a Lisp function) with two arguments,
297 the file name and info about the user who did the locking.
298 This function can signal an error, or return t meaning
299 take away the lock, or return nil meaning ignore the lock. */
302 lock_file (Lisp_Object fn)
304 /* This function can GC. GC checked 7-11-00 ben */
305 /* dmoore - and can destroy current_buffer and all sorts of other
306 mean nasty things with pointy teeth. If you call this make sure
307 you protect things right. */
308 /* Somebody updated the code in this function and removed the previous
311 register Lisp_Object attack, orig_fn;
312 register char *lfname, *locker;
313 lock_info_type lock_info;
314 struct gcpro gcpro1,gcpro2;
315 Lisp_Object subject_buf;
317 GCPRO2 (fn, subject_buf);
319 fn = Fexpand_file_name (fn, Qnil);
321 /* Create the name of the lock-file for file fn */
322 MAKE_LOCK_NAME (lfname, fn);
324 /* See if this file is visited and has changed on disk since it was
327 subject_buf = get_truename_buffer (orig_fn);
328 if (!NILP (subject_buf)
329 && NILP (Fverify_visited_file_modtime (subject_buf))
330 && !NILP (Ffile_exists_p (fn)))
331 call1_in_buffer (XBUFFER (subject_buf),
332 Qask_user_about_supersession_threat, fn);
335 /* Try to lock the lock. */
336 if (lock_if_free (&lock_info, lfname) <= 0)
337 /* Return now if we have locked it, or if lock creation failed */
340 /* Else consider breaking the lock */
341 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
343 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
345 FREE_LOCK_INFO (lock_info);
347 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
348 current_buffer, Qask_user_about_lock , fn,
349 build_string (locker));
351 /* User says take the lock */
353 lock_file_1 (lfname, 1);
356 /* User says ignore the lock */
362 unlock_file (Lisp_Object fn)
365 register char *lfname;
370 fn = Fexpand_file_name (fn, Qnil);
372 MAKE_LOCK_NAME (lfname, fn);
374 if (current_lock_owner (0, lfname) == 2)
381 unlock_all_files (void)
383 register Lisp_Object tail;
385 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
387 struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
388 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
389 unlock_file (b->file_truename);
393 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
394 Lock FILE, if current buffer is modified.
395 FILE defaults to current buffer's visited file,
396 or else nothing is done if current buffer isn't visiting a file.
401 file = current_buffer->file_truename;
403 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
409 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
410 Unlock the file visited in the current buffer,
411 if it should normally be locked.
415 /* This function can GC */
416 /* dmoore - and can destroy current_buffer and all sorts of other
417 mean nasty things with pointy teeth. If you call this make sure
418 you protect things right. */
420 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
421 && STRINGP (current_buffer->file_truename))
422 unlock_file (current_buffer->file_truename);
426 /* Unlock the file visited in buffer BUFFER. */
430 unlock_buffer (struct buffer *buffer)
432 /* This function can GC */
433 /* dmoore - and can destroy current_buffer and all sorts of other
434 mean nasty things with pointy teeth. If you call this make sure
435 you protect things right. */
436 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
437 && STRINGP (buffer->file_truename))
438 unlock_file (buffer->file_truename);
441 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
442 Return nil if the FILENAME is not locked,
443 t if it is locked by you, else a string of the name of the locker.
448 register char *lfname;
450 lock_info_type locker;
455 filename = Fexpand_file_name (filename, Qnil);
457 MAKE_LOCK_NAME (lfname, filename);
459 owner = current_lock_owner (&locker, lfname);
465 ret = build_string (locker.user);
468 FREE_LOCK_INFO (locker);
476 /* Initialization functions. */
479 syms_of_filelock (void)
481 /* This function can GC */
482 DEFSUBR (Funlock_buffer);
483 DEFSUBR (Flock_buffer);
484 DEFSUBR (Ffile_locked_p);
486 defsymbol (&Qask_user_about_supersession_threat,
487 "ask-user-about-supersession-threat");
488 defsymbol (&Qask_user_about_lock, "ask-user-about-lock");
492 #endif /* CLASH_DETECTION */