|
428
|
1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
|
|
|
2
|
|
|
3 This file is part of GNU Emacs.
|
|
|
4
|
|
|
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)
|
|
|
8 any later version.
|
|
|
9
|
|
|
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.
|
|
|
14
|
|
|
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. */
|
|
|
19
|
|
|
20 /* Synced with FSF 20.2 */
|
|
|
21
|
|
|
22 #include <config.h>
|
|
|
23 #include "lisp.h"
|
|
|
24
|
|
|
25 #include "buffer.h"
|
|
|
26 #include <paths.h>
|
|
|
27
|
|
|
28 #include "sysfile.h"
|
|
|
29 #include "sysdir.h"
|
|
|
30 #include "syspwd.h"
|
|
|
31 #include "syssignal.h" /* for kill */
|
|
|
32
|
|
|
33 Lisp_Object Qask_user_about_supersession_threat;
|
|
|
34 Lisp_Object Qask_user_about_lock;
|
|
|
35
|
|
|
36 #ifdef CLASH_DETECTION
|
|
|
37
|
|
|
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.
|
|
|
41
|
|
|
42 When the host in the lock data is the current host, we can check if
|
|
|
43 the pid is valid with kill.
|
|
|
44
|
|
|
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.
|
|
|
54
|
|
|
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.
|
|
|
62
|
|
|
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
|
|
|
65 symlinks.
|
|
|
66
|
|
|
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.
|
|
|
70
|
|
|
71 --karl@cs.umb.edu/karl@hq.ileaf.com. */
|
|
|
72
|
|
|
73
|
|
|
74 /* Here is the structure that stores information about a lock. */
|
|
|
75
|
|
|
76 typedef struct
|
|
|
77 {
|
|
|
78 char *user;
|
|
|
79 char *host;
|
|
|
80 unsigned long pid;
|
|
|
81 } lock_info_type;
|
|
|
82
|
|
|
83 /* When we read the info back, we might need this much more,
|
|
|
84 enough for decimal representation plus null. */
|
|
|
85 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
|
|
|
86
|
|
|
87 /* Free the two dynamically-allocated pieces in PTR. */
|
|
|
88 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
|
|
|
89
|
|
|
90 /* Write the name of the lock file for FN into LFNAME. Length will be
|
|
|
91 that of FN plus two more for the leading `.#' plus one for the null. */
|
|
|
92 #define MAKE_LOCK_NAME(lock, file) \
|
|
|
93 (lock = (char *) alloca (XSTRING_LENGTH(file) + 2 + 1), \
|
|
|
94 fill_in_lock_file_name (lock, (file)))
|
|
|
95
|
|
|
96 static void
|
|
|
97 fill_in_lock_file_name (lockfile, fn)
|
|
|
98 register char *lockfile;
|
|
|
99 register Lisp_Object fn;
|
|
|
100 {
|
|
|
101 register char *p;
|
|
|
102
|
|
|
103 strcpy (lockfile, XSTRING_DATA(fn));
|
|
|
104
|
|
|
105 /* Shift the nondirectory part of the file name (including the null)
|
|
|
106 right two characters. Here is one of the places where we'd have to
|
|
|
107 do something to support 14-character-max file names. */
|
|
|
108 for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
|
|
|
109 p[2] = *p;
|
|
|
110
|
|
|
111 /* Insert the `.#'. */
|
|
|
112 p[1] = '.';
|
|
|
113 p[2] = '#';
|
|
|
114 }
|
|
|
115
|
|
|
116 /* Lock the lock file named LFNAME.
|
|
|
117 If FORCE is nonzero, we do so even if it is already locked.
|
|
|
118 Return 1 if successful, 0 if not. */
|
|
|
119
|
|
|
120 static int
|
|
|
121 lock_file_1 (char *lfname,int force)
|
|
|
122 {
|
|
|
123 register int err;
|
|
|
124 char *user_name;
|
|
|
125 char *host_name;
|
|
|
126 char *lock_info_str;
|
|
|
127
|
|
|
128 if (STRINGP (Fuser_login_name (Qnil)))
|
|
|
129 user_name = (char *) XSTRING_DATA (Fuser_login_name (Qnil));
|
|
|
130 else
|
|
|
131 user_name = "";
|
|
|
132 if (STRINGP (Fsystem_name ()))
|
|
|
133 host_name = (char *) XSTRING_DATA (Fsystem_name ());
|
|
|
134 else
|
|
|
135 host_name = "";
|
|
|
136 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
|
|
|
137 + LOCK_PID_MAX + 5);
|
|
|
138
|
|
|
139 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
|
|
|
140 (unsigned long) getpid ());
|
|
|
141
|
|
|
142 err = symlink (lock_info_str, lfname);
|
|
|
143 if (errno == EEXIST && force)
|
|
|
144 {
|
|
|
145 unlink (lfname);
|
|
|
146 err = symlink (lock_info_str, lfname);
|
|
|
147 }
|
|
|
148
|
|
|
149 return err == 0;
|
|
|
150 }
|
|
|
151
|
|
|
152 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
|
|
|
153 1 if another process owns it (and set OWNER (if non-null) to info),
|
|
|
154 2 if the current process owns it,
|
|
|
155 or -1 if something is wrong with the locking mechanism. */
|
|
|
156
|
|
|
157 static int
|
|
|
158 current_lock_owner (lock_info_type *owner, char *lfname)
|
|
|
159 {
|
|
|
160 int o, p, len, ret;
|
|
|
161 int local_owner = 0;
|
|
|
162 char *at, *dot;
|
|
|
163 char *lfinfo = 0;
|
|
|
164 int bufsize = 50;
|
|
|
165 /* Read arbitrarily-long contents of symlink. Similar code in
|
|
|
166 file-symlink-p in fileio.c. */
|
|
|
167 do
|
|
|
168 {
|
|
|
169 bufsize *= 2;
|
|
|
170 lfinfo = (char *) xrealloc (lfinfo, bufsize);
|
|
|
171 len = readlink (lfname, lfinfo, bufsize);
|
|
|
172 }
|
|
|
173 while (len >= bufsize);
|
|
|
174
|
|
|
175 /* If nonexistent lock file, all is well; otherwise, got strange error. */
|
|
|
176 if (len == -1)
|
|
|
177 {
|
|
|
178 xfree (lfinfo);
|
|
|
179 return errno == ENOENT ? 0 : -1;
|
|
|
180 }
|
|
|
181
|
|
|
182 /* Link info exists, so `len' is its length. Null terminate. */
|
|
|
183 lfinfo[len] = 0;
|
|
|
184
|
|
|
185 /* Even if the caller doesn't want the owner info, we still have to
|
|
|
186 read it to determine return value, so allocate it. */
|
|
|
187 if (!owner)
|
|
|
188 {
|
|
|
189 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
|
|
|
190 local_owner = 1;
|
|
|
191 }
|
|
|
192
|
|
|
193 /* Parse USER@HOST.PID. If can't parse, return -1. */
|
|
|
194 /* The USER is everything before the first @. */
|
|
|
195 at = strchr (lfinfo, '@');
|
|
|
196 dot = strrchr (lfinfo, '.');
|
|
|
197 if (!at || !dot) {
|
|
|
198 xfree (lfinfo);
|
|
|
199 return -1;
|
|
|
200 }
|
|
|
201 len = at - lfinfo;
|
|
|
202 owner->user = (char *) xmalloc (len + 1);
|
|
|
203 strncpy (owner->user, lfinfo, len);
|
|
|
204 owner->user[len] = 0;
|
|
|
205
|
|
|
206 /* The PID is everything after the last `.'. */
|
|
|
207 owner->pid = atoi (dot + 1);
|
|
|
208
|
|
|
209 /* The host is everything in between. */
|
|
|
210 len = dot - at - 1;
|
|
|
211 owner->host = (char *) xmalloc (len + 1);
|
|
|
212 strncpy (owner->host, at + 1, len);
|
|
|
213 owner->host[len] = 0;
|
|
|
214
|
|
|
215 /* We're done looking at the link info. */
|
|
|
216 xfree (lfinfo);
|
|
|
217
|
|
|
218 /* On current host? */
|
|
|
219 if (STRINGP (Fsystem_name ())
|
|
|
220 && strcmp (owner->host, XSTRING_DATA(Fsystem_name ())) == 0)
|
|
|
221 {
|
|
|
222 if (owner->pid == getpid ())
|
|
|
223 ret = 2; /* We own it. */
|
|
|
224 else if (owner->pid > 0
|
|
|
225 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
|
|
|
226 ret = 1; /* An existing process on this machine owns it. */
|
|
|
227 /* The owner process is dead or has a strange pid (<=0), so try to
|
|
|
228 zap the lockfile. */
|
|
|
229 else if (unlink (lfname) < 0)
|
|
|
230 ret = -1;
|
|
|
231 else
|
|
|
232 ret = 0;
|
|
|
233 }
|
|
|
234 else
|
|
|
235 { /* If we wanted to support the check for stale locks on remote machines,
|
|
|
236 here's where we'd do it. */
|
|
|
237 ret = 1;
|
|
|
238 }
|
|
|
239
|
|
|
240 /* Avoid garbage. */
|
|
|
241 if (local_owner || ret <= 0)
|
|
|
242 {
|
|
|
243 FREE_LOCK_INFO (*owner);
|
|
|
244 }
|
|
|
245 return ret;
|
|
|
246 }
|
|
|
247
|
|
|
248 /* Lock the lock named LFNAME if possible.
|
|
|
249 Return 0 in that case.
|
|
|
250 Return positive if some other process owns the lock, and info about
|
|
|
251 that process in CLASHER.
|
|
|
252 Return -1 if cannot lock for any other reason. */
|
|
|
253
|
|
|
254 static int
|
|
|
255 lock_if_free (lock_info_type *clasher, char *lfname)
|
|
|
256 {
|
|
|
257 if (lock_file_1 (lfname, 0) == 0)
|
|
|
258 {
|
|
|
259 int locker;
|
|
|
260
|
|
|
261 if (errno != EEXIST)
|
|
|
262 return -1;
|
|
|
263
|
|
|
264 locker = current_lock_owner (clasher, lfname);
|
|
|
265 if (locker == 2)
|
|
|
266 {
|
|
|
267 FREE_LOCK_INFO (*clasher);
|
|
|
268 return 0; /* We ourselves locked it. */
|
|
|
269 }
|
|
|
270 else if (locker == 1)
|
|
|
271 return 1; /* Someone else has it. */
|
|
|
272
|
|
|
273 return -1; /* Something's wrong. */
|
|
|
274 }
|
|
|
275 return 0;
|
|
|
276 }
|
|
|
277
|
|
|
278 /* lock_file locks file FN,
|
|
|
279 meaning it serves notice on the world that you intend to edit that file.
|
|
|
280 This should be done only when about to modify a file-visiting
|
|
|
281 buffer previously unmodified.
|
|
|
282 Do not (normally) call this for a buffer already modified,
|
|
|
283 as either the file is already locked, or the user has already
|
|
|
284 decided to go ahead without locking.
|
|
|
285
|
|
|
286 When this returns, either the lock is locked for us,
|
|
|
287 or the user has said to go ahead without locking.
|
|
|
288
|
|
|
289 If the file is locked by someone else, this calls
|
|
|
290 ask-user-about-lock (a Lisp function) with two arguments,
|
|
|
291 the file name and info about the user who did the locking.
|
|
|
292 This function can signal an error, or return t meaning
|
|
|
293 take away the lock, or return nil meaning ignore the lock. */
|
|
|
294
|
|
|
295 void
|
|
|
296 lock_file (Lisp_Object fn)
|
|
|
297 {
|
|
|
298 /* This function can GC. */
|
|
|
299 /* dmoore - and can destroy current_buffer and all sorts of other
|
|
|
300 mean nasty things with pointy teeth. If you call this make sure
|
|
|
301 you protect things right. */
|
|
|
302 /* Somebody updated the code in this function and removed the previous
|
|
|
303 comment. -slb */
|
|
|
304
|
|
|
305 register Lisp_Object attack, orig_fn;
|
|
|
306 register char *lfname, *locker;
|
|
|
307 lock_info_type lock_info;
|
|
|
308 struct gcpro gcpro1,gcpro2;
|
|
|
309 Lisp_Object subject_buf;
|
|
|
310
|
|
|
311 GCPRO2 (fn, subject_buf);
|
|
|
312 orig_fn = fn;
|
|
|
313 fn = Fexpand_file_name (fn, Qnil);
|
|
|
314
|
|
|
315 /* Create the name of the lock-file for file fn */
|
|
|
316 MAKE_LOCK_NAME (lfname, fn);
|
|
|
317
|
|
|
318 /* See if this file is visited and has changed on disk since it was
|
|
|
319 visited. */
|
|
|
320 {
|
|
|
321 subject_buf = get_truename_buffer (orig_fn);
|
|
|
322 if (!NILP (subject_buf)
|
|
|
323 && NILP (Fverify_visited_file_modtime (subject_buf))
|
|
|
324 && !NILP (Ffile_exists_p (fn)))
|
|
|
325 call1_in_buffer (XBUFFER(subject_buf),
|
|
|
326 Qask_user_about_supersession_threat, fn);
|
|
|
327 }
|
|
|
328
|
|
|
329 /* Try to lock the lock. */
|
|
|
330 if (lock_if_free (&lock_info, lfname) <= 0)
|
|
|
331 /* Return now if we have locked it, or if lock creation failed */
|
|
|
332 goto done;
|
|
|
333
|
|
|
334 /* Else consider breaking the lock */
|
|
|
335 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
|
|
|
336 + LOCK_PID_MAX + 9);
|
|
|
337 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
|
|
|
338 lock_info.pid);
|
|
|
339 FREE_LOCK_INFO (lock_info);
|
|
|
340
|
|
|
341 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
|
|
|
342 current_buffer, Qask_user_about_lock , fn,
|
|
|
343 build_string (locker));
|
|
|
344 if (!NILP (attack))
|
|
|
345 /* User says take the lock */
|
|
|
346 {
|
|
|
347 lock_file_1 (lfname, 1);
|
|
|
348 goto done;
|
|
|
349 }
|
|
|
350 /* User says ignore the lock */
|
|
|
351 done:
|
|
|
352 UNGCPRO;
|
|
|
353 }
|
|
|
354
|
|
|
355 void
|
|
|
356 unlock_file (Lisp_Object fn)
|
|
|
357 {
|
|
|
358 register char *lfname;
|
|
|
359
|
|
|
360 fn = Fexpand_file_name (fn, Qnil);
|
|
|
361
|
|
|
362 MAKE_LOCK_NAME (lfname, fn);
|
|
|
363
|
|
|
364 if (current_lock_owner (0, lfname) == 2)
|
|
|
365 unlink (lfname);
|
|
|
366 }
|
|
|
367
|
|
|
368 void
|
|
|
369 unlock_all_files ()
|
|
|
370 {
|
|
|
371 register Lisp_Object tail;
|
|
|
372 register struct buffer *b;
|
|
|
373
|
|
434
|
374 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
|
|
428
|
375 {
|
|
|
376 b = XBUFFER (XCDR (XCAR (tail)));
|
|
|
377 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
|
|
|
378 unlock_file (b->file_truename);
|
|
|
379 }
|
|
|
380 }
|
|
|
381
|
|
|
382 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
|
|
|
383 Lock FILE, if current buffer is modified.\n\
|
|
|
384 FILE defaults to current buffer's visited file,\n\
|
|
|
385 or else nothing is done if current buffer isn't visiting a file.
|
|
|
386 */
|
|
|
387 (file))
|
|
|
388 {
|
|
|
389 if (NILP (file))
|
|
|
390 file = current_buffer->file_truename;
|
|
|
391 CHECK_STRING (file);
|
|
|
392 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
|
|
|
393 && !NILP (file))
|
|
|
394 lock_file (file);
|
|
|
395 return Qnil;
|
|
|
396 }
|
|
|
397
|
|
|
398 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
|
|
|
399 Unlock the file visited in the current buffer,
|
|
|
400 if it should normally be locked.
|
|
|
401 */
|
|
|
402 ())
|
|
|
403 {
|
|
|
404 /* This function can GC */
|
|
|
405 /* dmoore - and can destroy current_buffer and all sorts of other
|
|
|
406 mean nasty things with pointy teeth. If you call this make sure
|
|
|
407 you protect things right. */
|
|
|
408
|
|
|
409 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
|
|
|
410 && STRINGP (current_buffer->file_truename))
|
|
|
411 unlock_file (current_buffer->file_truename);
|
|
|
412 return Qnil;
|
|
|
413 }
|
|
|
414
|
|
|
415 /* Unlock the file visited in buffer BUFFER. */
|
|
|
416
|
|
|
417
|
|
|
418 void
|
|
|
419 unlock_buffer (struct buffer *buffer)
|
|
|
420 {
|
|
|
421 /* This function can GC */
|
|
|
422 /* dmoore - and can destroy current_buffer and all sorts of other
|
|
|
423 mean nasty things with pointy teeth. If you call this make sure
|
|
|
424 you protect things right. */
|
|
|
425 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
|
|
|
426 && STRINGP (buffer->file_truename))
|
|
|
427 unlock_file (buffer->file_truename);
|
|
|
428 }
|
|
|
429
|
|
|
430 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
|
|
|
431 Return nil if the FILENAME is not locked,\n\
|
|
|
432 t if it is locked by you, else a string of the name of the locker.
|
|
|
433 */
|
|
|
434 (filename))
|
|
|
435 {
|
|
|
436 Lisp_Object ret;
|
|
|
437 register char *lfname;
|
|
|
438 int owner;
|
|
|
439 lock_info_type locker;
|
|
|
440
|
|
|
441 filename = Fexpand_file_name (filename, Qnil);
|
|
|
442
|
|
|
443 MAKE_LOCK_NAME (lfname, filename);
|
|
|
444
|
|
|
445 owner = current_lock_owner (&locker, lfname);
|
|
|
446 if (owner <= 0)
|
|
|
447 ret = Qnil;
|
|
|
448 else if (owner == 2)
|
|
|
449 ret = Qt;
|
|
|
450 else
|
|
|
451 ret = build_string (locker.user);
|
|
|
452
|
|
|
453 if (owner > 0)
|
|
|
454 FREE_LOCK_INFO (locker);
|
|
|
455
|
|
|
456 return ret;
|
|
|
457 }
|
|
|
458
|
|
|
459
|
|
|
460 /* Initialization functions. */
|
|
|
461
|
|
|
462 void
|
|
|
463 syms_of_filelock (void)
|
|
|
464 {
|
|
|
465 /* This function can GC */
|
|
|
466 DEFSUBR (Funlock_buffer);
|
|
|
467 DEFSUBR (Flock_buffer);
|
|
|
468 DEFSUBR (Ffile_locked_p);
|
|
|
469
|
|
|
470 defsymbol (&Qask_user_about_supersession_threat,
|
|
|
471 "ask-user-about-supersession-threat");
|
|
|
472 defsymbol (&Qask_user_about_lock, "ask-user-about-lock");
|
|
|
473 }
|
|
|
474
|
|
|
475
|
|
|
476 #endif /* CLASH_DETECTION */
|
