1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
3 This file is part of SXEmacs
5 SXEmacs 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 3 of the License, or
8 (at your option) any later version.
10 SXEmacs 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 this program. If not, see <http://www.gnu.org/licenses/>. */
19 /* Synced with FSF 20.2 */
25 #include <sxe-paths.h>
30 #include "syssignal.h" /* for kill */
32 Lisp_Object Qask_user_about_supersession_threat;
33 Lisp_Object Qask_user_about_lock;
34 int inhibit_clash_detection;
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... */
76 /* Here is the structure that stores information about a lock. */
84 /* When we read the info back, we might need this much more,
85 enough for decimal representation plus null. */
86 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
88 /* Free the two dynamically-allocated pieces in PTR. */
89 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
91 /* Write the name of the lock file for FN into LFNAME. Length will be
92 that of FN plus two more for the leading `.#' plus one for the null. */
93 #define MAKE_LOCK_NAME(lock, file) \
94 (lock = (char *) alloca (XSTRING_LENGTH (file) + 2 + 1), \
95 fill_in_lock_file_name ((Bufbyte *) (lock), (file)))
97 static void fill_in_lock_file_name(Bufbyte * lockfile, Lisp_Object fn)
99 Bufbyte *file_name = XSTRING_DATA(fn);
103 for (p = file_name + XSTRING_LENGTH(fn) - 1;
104 p > file_name && !IS_ANY_SEP(p[-1]); p--) ;
105 dirlen = p - file_name;
107 memcpy(lockfile, file_name, dirlen);
108 p = lockfile + dirlen;
111 memcpy(p, file_name + dirlen, XSTRING_LENGTH(fn) - dirlen + 1);
114 /* Lock the lock file named LFNAME.
115 If FORCE is nonzero, we do so even if it is already locked.
116 Return 1 if successful, 0 if not. */
118 static int lock_file_1(char *lfname, int force)
124 char *user_name = user_login_name(NULL);
126 if (user_name == NULL)
129 if (STRINGP(Vsystem_name))
130 host_name = (char *)XSTRING_DATA(Vsystem_name);
134 lock_info_str = (char *)alloca(strlen(user_name) + strlen(host_name)
137 sprintf(lock_info_str, "%s@%s.%lu", user_name, host_name,
138 (unsigned long)getpid());
140 err = symlink(lock_info_str, lfname);
141 if (err != 0 && errno == EEXIST && force) {
143 err = symlink(lock_info_str, lfname);
149 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
150 1 if another process owns it (and set OWNER (if non-null) to info),
151 2 if the current process owns it,
152 or -1 if something is wrong with the locking mechanism. */
154 static int current_lock_owner(lock_info_type * owner, char *lfname)
162 /* Read arbitrarily-long contents of symlink. Similar code in
163 file-symlink-p in fileio.c. */
166 lfinfo = (char *)xrealloc(lfinfo, bufsize);
167 len = readlink(lfname, lfinfo, bufsize);
169 while (len >= bufsize);
171 /* If nonexistent lock file, all is well; otherwise, got strange error. */
174 return errno == ENOENT ? 0 : -1;
177 /* Link info exists, so `len' is its length. Null terminate. */
180 /* Even if the caller doesn't want the owner info, we still have to
181 read it to determine return value, so allocate it. */
183 owner = (lock_info_type *) alloca(sizeof(lock_info_type));
187 /* Parse USER@HOST.PID. If can't parse, return -1. */
188 /* The USER is everything before the first @. */
189 at = strchr(lfinfo, '@');
190 dot = strrchr(lfinfo, '.');
196 owner->user = (char *)xmalloc_atomic(len + 1);
197 strncpy(owner->user, lfinfo, len);
198 owner->user[len] = 0;
200 /* The PID is everything after the last `.'. */
201 owner->pid = atoi(dot + 1);
203 /* The host is everything in between. */
205 owner->host = (char *)xmalloc_atomic(len + 1);
206 strncpy(owner->host, at + 1, len);
207 owner->host[len] = 0;
209 /* We're done looking at the link info. */
212 /* On current host? */
213 if (STRINGP(Fsystem_name())
214 && strcmp(owner->host, (char *)XSTRING_DATA(Fsystem_name())) == 0) {
215 if (owner->pid == (unsigned long)getpid())
216 ret = 2; /* We own it. */
217 else if (owner->pid > 0
218 && (kill(owner->pid, 0) >= 0 || errno == EPERM))
219 ret = 1; /* An existing process on this machine owns it. */
220 /* The owner process is dead or has a strange pid (<=0), so try to
222 else if (unlink(lfname) < 0)
226 } else { /* If we wanted to support the check for stale locks on remote machines,
227 here's where we'd do it. */
232 if (local_owner || ret <= 0) {
233 FREE_LOCK_INFO(*owner);
238 /* Lock the lock named LFNAME if possible.
239 Return 0 in that case.
240 Return positive if some other process owns the lock, and info about
241 that process in CLASHER.
242 Return -1 if cannot lock for any other reason. */
244 static int lock_if_free(lock_info_type * clasher, char *lfname)
247 if (lock_file_1(lfname, 0) == 0) {
253 locker = current_lock_owner(clasher, lfname);
255 FREE_LOCK_INFO(*clasher);
256 return 0; /* We ourselves locked it. */
257 } else if (locker == 1)
258 return 1; /* Someone else has it. */
260 return -1; /* Something's wrong. */
265 /* lock_file locks file FN,
266 meaning it serves notice on the world that you intend to edit that file.
267 This should be done only when about to modify a file-visiting
268 buffer previously unmodified.
269 Do not (normally) call this for a buffer already modified,
270 as either the file is already locked, or the user has already
271 decided to go ahead without locking.
273 When this returns, either the lock is locked for us,
274 or the user has said to go ahead without locking.
276 If the file is locked by someone else, this calls
277 ask-user-about-lock (a Lisp function) with two arguments,
278 the file name and info about the user who did the locking.
279 This function can signal an error, or return t meaning
280 take away the lock, or return nil meaning ignore the lock. */
282 void lock_file(Lisp_Object fn)
284 /* This function can GC. GC checked 7-11-00 ben */
285 /* dmoore - and can destroy current_buffer and all sorts of other
286 mean nasty things with pointy teeth. If you call this make sure
287 you protect things right. */
288 /* Somebody updated the code in this function and removed the previous
291 register Lisp_Object attack, orig_fn;
292 register char *lfname, *locker;
293 lock_info_type lock_info;
294 struct gcpro gcpro1, gcpro2, gcpro3;
295 Lisp_Object old_current_buffer;
296 Lisp_Object subject_buf;
298 if (inhibit_clash_detection)
301 XSETBUFFER(old_current_buffer, current_buffer);
303 GCPRO3(fn, subject_buf, old_current_buffer);
305 fn = Fexpand_file_name(fn, Qnil);
307 /* Create the name of the lock-file for file fn */
308 MAKE_LOCK_NAME(lfname, fn);
310 /* See if this file is visited and has changed on disk since it was
313 subject_buf = get_truename_buffer(orig_fn);
314 if (!NILP(subject_buf)
315 && NILP(Fverify_visited_file_modtime(subject_buf))
316 && !NILP(Ffile_exists_p(fn)))
317 call1_in_buffer(XBUFFER(subject_buf),
318 Qask_user_about_supersession_threat,
322 /* Try to lock the lock. */
323 if (current_buffer != XBUFFER(old_current_buffer)
324 || lock_if_free(&lock_info, lfname) <= 0)
325 /* Return now if we have locked it, or if lock creation failed
326 or current buffer is killed. */
329 /* Else consider breaking the lock */
330 locker = (char *)alloca(strlen(lock_info.user) + strlen(lock_info.host)
332 sprintf(locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
334 FREE_LOCK_INFO(lock_info);
336 attack = call2_in_buffer(BUFFERP(subject_buf) ? XBUFFER(subject_buf) :
337 current_buffer, Qask_user_about_lock, fn,
338 build_string(locker));
339 if (!NILP(attack) && current_buffer == XBUFFER(old_current_buffer))
340 /* User says take the lock */
342 lock_file_1(lfname, 1);
345 /* User says ignore the lock */
350 void unlock_file(Lisp_Object fn)
353 register char *lfname;
358 fn = Fexpand_file_name(fn, Qnil);
360 MAKE_LOCK_NAME(lfname, fn);
362 if (current_lock_owner(0, lfname) == 2)
368 void unlock_all_files(void)
370 register Lisp_Object tail;
372 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
373 struct buffer *b = XBUFFER(XCDR(XCAR(tail)));
374 if (STRINGP(b->file_truename)
375 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b))
376 unlock_file(b->file_truename);
380 DEFUN("lock-buffer", Flock_buffer, 0, 1, 0, /*
381 Lock FILE, if current buffer is modified.
382 FILE defaults to current buffer's visited file,
383 or else nothing is done if current buffer isn't visiting a file.
388 file = current_buffer->file_truename;
390 if (BUF_SAVE_MODIFF(current_buffer) < BUF_MODIFF(current_buffer)
396 DEFUN("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
397 Unlock the file visited in the current buffer,
398 if it should normally be locked.
402 /* This function can GC */
403 /* dmoore - and can destroy current_buffer and all sorts of other
404 mean nasty things with pointy teeth. If you call this make sure
405 you protect things right. */
407 if (BUF_SAVE_MODIFF(current_buffer) < BUF_MODIFF(current_buffer)
408 && STRINGP(current_buffer->file_truename))
409 unlock_file(current_buffer->file_truename);
413 /* Unlock the file visited in buffer BUFFER. */
415 void unlock_buffer(struct buffer *buffer)
417 /* This function can GC */
418 /* dmoore - and can destroy current_buffer and all sorts of other
419 mean nasty things with pointy teeth. If you call this make sure
420 you protect things right. */
421 if (BUF_SAVE_MODIFF(buffer) < BUF_MODIFF(buffer)
422 && STRINGP(buffer->file_truename))
423 unlock_file(buffer->file_truename);
426 DEFUN("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
427 Return nil if the FILENAME is not locked,
428 t if it is locked by you, else a string of the name of the locker.
433 register char *lfname;
435 lock_info_type locker;
440 filename = Fexpand_file_name(filename, Qnil);
442 MAKE_LOCK_NAME(lfname, filename);
444 owner = current_lock_owner(&locker, lfname);
450 ret = build_string(locker.user);
453 FREE_LOCK_INFO(locker);
460 /* Initialization functions. */
462 void syms_of_filelock(void)
464 /* This function can GC */
465 DEFSUBR(Funlock_buffer);
466 DEFSUBR(Flock_buffer);
467 DEFSUBR(Ffile_locked_p);
469 defsymbol(&Qask_user_about_supersession_threat,
470 "ask-user-about-supersession-threat");
471 defsymbol(&Qask_user_about_lock, "ask-user-about-lock");
474 void vars_of_filelock(void)
476 DEFVAR_BOOL("inhibit-clash-detection", &inhibit_clash_detection /*
477 Non-nil inhibits creation of lock file to detect clash.
479 inhibit_clash_detection = 0;
482 #endif /* CLASH_DETECTION */