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. */
21 #include <sys/types.h>
45 #ifdef CLASH_DETECTION
47 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
48 directory, with link data `user@host.pid'. This avoids a single
49 mount (== failure) point for lock files.
51 When the host in the lock data is the current host, we can check if
52 the pid is valid with kill.
54 Otherwise, we could look at a separate file that maps hostnames to
55 reboot times to see if the remote pid can possibly be valid, since we
56 don't want Emacs to have to communicate via pipes or sockets or
57 whatever to other processes, either locally or remotely; rms says
58 that's too unreliable. Hence the separate file, which could
59 theoretically be updated by daemons running separately -- but this
60 whole idea is unimplemented; in practice, at least in our
61 environment, it seems such stale locks arise fairly infrequently, and
62 Emacs' standard methods of dealing with clashes suffice.
64 We use symlinks instead of normal files because (1) they can be
65 stored more efficiently on the filesystem, since the kernel knows
66 they will be small, and (2) all the info about the lock can be read
67 in a single system call (readlink). Although we could use regular
68 files to be useful on old systems lacking symlinks, nowadays
69 virtually all such systems are probably single-user anyway, so it
70 didn't seem worth the complication.
72 Similarly, we don't worry about a possible 14-character limit on
73 file names, because those are all the same systems that don't have
76 This is compatible with the locking scheme used by Interleaf (which
77 has contributed this implementation for Emacs), and was designed by
78 Ethan Jacobson, Kimbo Mundy, and others.
80 --karl@cs.umb.edu/karl@hq.ileaf.com. */
83 /* Here is the structure that stores information about a lock. */
92 /* When we read the info back, we might need this much more,
93 enough for decimal representation plus null. */
94 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
96 /* Free the two dynamically-allocated pieces in PTR. */
97 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
100 /* Write the name of the lock file for FN into LFNAME. Length will be
101 that of FN plus two more for the leading `.#' plus one for the null. */
102 #define MAKE_LOCK_NAME(lock, file) \
103 (lock = (char *) alloca (XSTRING (file)->size + 2 + 1), \
104 fill_in_lock_file_name (lock, (file)))
107 fill_in_lock_file_name (lockfile
, fn
)
108 register char *lockfile
;
109 register Lisp_Object fn
;
113 strcpy (lockfile
, XSTRING (fn
)->data
);
115 /* Shift the nondirectory part of the file name (including the null)
116 right two characters. Here is one of the places where we'd have to
117 do something to support 14-character-max file names. */
118 for (p
= lockfile
+ strlen (lockfile
); p
!= lockfile
&& *p
!= '/'; p
--)
121 /* Insert the `.#'. */
126 /* Lock the lock file named LFNAME.
127 If FORCE is nonzero, we do so even if it is already locked.
128 Return 1 if successful, 0 if not. */
131 lock_file_1 (lfname
, force
)
140 if (STRINGP (Fuser_login_name (Qnil
)))
141 user_name
= (char *)XSTRING (Fuser_login_name (Qnil
))->data
;
144 if (STRINGP (Fsystem_name ()))
145 host_name
= (char *)XSTRING (Fsystem_name ())->data
;
148 lock_info_str
= (char *)alloca (strlen (user_name
) + strlen (host_name
)
151 sprintf (lock_info_str
, "%s@%s.%lu", user_name
, host_name
,
152 (unsigned long) getpid ());
154 err
= symlink (lock_info_str
, lfname
);
155 if (errno
== EEXIST
&& force
)
158 err
= symlink (lock_info_str
, lfname
);
166 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
167 1 if another process owns it (and set OWNER (if non-null) to info),
168 2 if the current process owns it,
169 or -1 if something is wrong with the locking mechanism. */
172 current_lock_owner (owner
, lfname
)
173 lock_info_type
*owner
;
177 extern char *rindex (), *index ();
184 /* Read arbitrarily-long contents of symlink. Similar code in
185 file-symlink-p in fileio.c. */
189 lfinfo
= (char *) xrealloc (lfinfo
, bufsize
);
190 len
= readlink (lfname
, lfinfo
, bufsize
);
192 while (len
>= bufsize
);
194 /* If nonexistent lock file, all is well; otherwise, got strange error. */
198 return errno
== ENOENT
? 0 : -1;
201 /* Link info exists, so `len' is its length. Null terminate. */
204 /* Even if the caller doesn't want the owner info, we still have to
205 read it to determine return value, so allocate it. */
208 owner
= (lock_info_type
*) alloca (sizeof (lock_info_type
));
212 /* Parse USER@HOST.PID. If can't parse, return -1. */
213 /* The USER is everything before the first @. */
214 at
= index (lfinfo
, '@');
215 dot
= rindex (lfinfo
, '.');
221 owner
->user
= (char *) xmalloc (len
+ 1);
222 strncpy (owner
->user
, lfinfo
, len
);
223 owner
->user
[len
] = 0;
225 /* The PID is everything after the last `.'. */
226 owner
->pid
= atoi (dot
+ 1);
228 /* The host is everything in between. */
230 owner
->host
= (char *) xmalloc (len
+ 1);
231 strncpy (owner
->host
, at
+ 1, len
);
232 owner
->host
[len
] = 0;
234 /* We're done looking at the link info. */
237 /* On current host? */
238 if (STRINGP (Fsystem_name ())
239 && strcmp (owner
->host
, XSTRING (Fsystem_name ())->data
) == 0)
241 if (owner
->pid
== getpid ())
242 ret
= 2; /* We own it. */
243 else if (owner
->pid
> 0
244 && (kill (owner
->pid
, 0) >= 0 || errno
== EPERM
))
245 ret
= 1; /* An existing process on this machine owns it. */
246 /* The owner process is dead or has a strange pid (<=0), so try to
248 else if (unlink (lfname
) < 0)
254 { /* If we wanted to support the check for stale locks on remote machines,
255 here's where we'd do it. */
260 if (local_owner
|| ret
<= 0)
262 FREE_LOCK_INFO (*owner
);
268 /* Lock the lock named LFNAME if possible.
269 Return 0 in that case.
270 Return positive if some other process owns the lock, and info about
271 that process in CLASHER.
272 Return -1 if cannot lock for any other reason. */
275 lock_if_free (clasher
, lfname
)
276 lock_info_type
*clasher
;
277 register char *lfname
;
279 if (lock_file_1 (lfname
, 0) == 0)
286 locker
= current_lock_owner (clasher
, lfname
);
289 FREE_LOCK_INFO (*clasher
);
290 return 0; /* We ourselves locked it. */
292 else if (locker
== 1)
293 return 1; /* Someone else has it. */
295 return -1; /* Something's wrong. */
300 /* lock_file locks file FN,
301 meaning it serves notice on the world that you intend to edit that file.
302 This should be done only when about to modify a file-visiting
303 buffer previously unmodified.
304 Do not (normally) call this for a buffer already modified,
305 as either the file is already locked, or the user has already
306 decided to go ahead without locking.
308 When this returns, either the lock is locked for us,
309 or the user has said to go ahead without locking.
311 If the file is locked by someone else, this calls
312 ask-user-about-lock (a Lisp function) with two arguments,
313 the file name and info about the user who did the locking.
314 This function can signal an error, or return t meaning
315 take away the lock, or return nil meaning ignore the lock. */
319 register Lisp_Object fn
;
321 register Lisp_Object attack
, orig_fn
;
322 register char *lfname
, *locker
;
323 lock_info_type lock_info
;
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 register Lisp_Object subject_buf
;
335 subject_buf
= get_truename_buffer (orig_fn
);
336 if (!NILP (subject_buf
)
337 && NILP (Fverify_visited_file_modtime (subject_buf
))
338 && !NILP (Ffile_exists_p (fn
)))
339 call1 (intern ("ask-user-about-supersession-threat"), fn
);
342 /* Try to lock the lock. */
343 if (lock_if_free (&lock_info
, lfname
) <= 0)
344 /* Return now if we have locked it, or if lock creation failed */
347 /* Else consider breaking the lock */
348 locker
= (char *) alloca (strlen (lock_info
.user
) + strlen (lock_info
.host
)
350 sprintf (locker
, "%s@%s (pid %lu)", lock_info
.user
, lock_info
.host
,
352 FREE_LOCK_INFO (lock_info
);
354 attack
= call2 (intern ("ask-user-about-lock"), fn
, build_string (locker
));
356 /* User says take the lock */
358 lock_file_1 (lfname
, 1);
361 /* User says ignore the lock */
366 register Lisp_Object fn
;
368 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 register Lisp_Object tail
;
382 register struct buffer
*b
;
384 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
386 b
= XBUFFER (XCONS (XCONS (tail
)->car
)->cdr
);
387 if (STRINGP (b
->file_truename
) && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
))
388 unlock_file (b
->file_truename
);
392 DEFUN ("lock-buffer", Flock_buffer
, Slock_buffer
,
394 "Lock FILE, if current buffer is modified.\n\
395 FILE defaults to current buffer's visited file,\n\
396 or else nothing is done if current buffer isn't visiting a file.")
401 file
= current_buffer
->file_truename
;
403 CHECK_STRING (file
, 0);
404 if (SAVE_MODIFF
< MODIFF
410 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
412 "Unlock the file visited in the current buffer,\n\
413 if it should normally be locked.")
416 if (SAVE_MODIFF
< MODIFF
417 && STRINGP (current_buffer
->file_truename
))
418 unlock_file (current_buffer
->file_truename
);
422 /* Unlock the file visited in buffer BUFFER. */
424 unlock_buffer (buffer
)
425 struct buffer
*buffer
;
427 if (BUF_SAVE_MODIFF (buffer
) < BUF_MODIFF (buffer
)
428 && STRINGP (buffer
->file_truename
))
429 unlock_file (buffer
->file_truename
);
432 DEFUN ("file-locked-p", Ffile_locked_p
, Sfile_locked_p
, 0, 1, 0,
433 "Return nil if the FILENAME is not locked,\n\
434 t if it is locked by you, else a string of the name of the locker.")
436 Lisp_Object filename
;
439 register char *lfname
;
441 lock_info_type locker
;
443 filename
= Fexpand_file_name (filename
, Qnil
);
445 MAKE_LOCK_NAME (lfname
, filename
);
447 owner
= current_lock_owner (&locker
, lfname
);
453 ret
= build_string (locker
.user
);
456 FREE_LOCK_INFO (locker
);
462 /* Initialization functions. */
466 defsubr (&Sunlock_buffer
);
467 defsubr (&Slock_buffer
);
468 defsubr (&Sfile_locked_p
);
471 #endif /* CLASH_DETECTION */