428
|
1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
|
771
|
2 Copyright (C) 2001 Ben Wing.
|
428
|
3
|
613
|
4 This file is part of XEmacs.
|
428
|
5
|
613
|
6 XEmacs is free software; you can redistribute it and/or modify
|
428
|
7 it under the terms of the GNU General Public License as published by
|
|
8 the Free Software Foundation; either version 2, or (at your option)
|
|
9 any later version.
|
|
10
|
613
|
11 XEmacs is distributed in the hope that it will be useful,
|
428
|
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
14 GNU General Public License for more details.
|
|
15
|
|
16 You should have received a copy of the GNU General Public License
|
613
|
17 along with XEmacs; see the file COPYING. If not, write to
|
428
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
19 Boston, MA 02111-1307, USA. */
|
|
20
|
|
21 /* Synced with FSF 20.2 */
|
|
22
|
|
23 #include <config.h>
|
|
24 #include "lisp.h"
|
|
25
|
|
26 #include "buffer.h"
|
|
27 #include <paths.h>
|
|
28
|
859
|
29 #include "sysdir.h"
|
428
|
30 #include "sysfile.h"
|
859
|
31 #include "sysproc.h" /* for qxe_getpid() */
|
428
|
32 #include "syspwd.h"
|
859
|
33 #include "syssignal.h" /* for kill. */
|
428
|
34
|
|
35 Lisp_Object Qask_user_about_supersession_threat;
|
|
36 Lisp_Object Qask_user_about_lock;
|
444
|
37 int inhibit_clash_detection;
|
428
|
38
|
|
39 #ifdef CLASH_DETECTION
|
442
|
40
|
428
|
41 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
|
|
42 directory, with link data `user@host.pid'. This avoids a single
|
|
43 mount (== failure) point for lock files.
|
|
44
|
|
45 When the host in the lock data is the current host, we can check if
|
|
46 the pid is valid with kill.
|
442
|
47
|
428
|
48 Otherwise, we could look at a separate file that maps hostnames to
|
|
49 reboot times to see if the remote pid can possibly be valid, since we
|
|
50 don't want Emacs to have to communicate via pipes or sockets or
|
|
51 whatever to other processes, either locally or remotely; rms says
|
|
52 that's too unreliable. Hence the separate file, which could
|
|
53 theoretically be updated by daemons running separately -- but this
|
|
54 whole idea is unimplemented; in practice, at least in our
|
|
55 environment, it seems such stale locks arise fairly infrequently, and
|
|
56 Emacs' standard methods of dealing with clashes suffice.
|
|
57
|
|
58 We use symlinks instead of normal files because (1) they can be
|
|
59 stored more efficiently on the filesystem, since the kernel knows
|
|
60 they will be small, and (2) all the info about the lock can be read
|
|
61 in a single system call (readlink). Although we could use regular
|
|
62 files to be useful on old systems lacking symlinks, nowadays
|
|
63 virtually all such systems are probably single-user anyway, so it
|
|
64 didn't seem worth the complication.
|
|
65
|
|
66 Similarly, we don't worry about a possible 14-character limit on
|
|
67 file names, because those are all the same systems that don't have
|
|
68 symlinks.
|
442
|
69
|
428
|
70 This is compatible with the locking scheme used by Interleaf (which
|
|
71 has contributed this implementation for Emacs), and was designed by
|
|
72 Ethan Jacobson, Kimbo Mundy, and others.
|
442
|
73
|
428
|
74 --karl@cs.umb.edu/karl@hq.ileaf.com. */
|
|
75
|
|
76
|
|
77 /* Here is the structure that stores information about a lock. */
|
|
78
|
|
79 typedef struct
|
|
80 {
|
867
|
81 Ibyte *user;
|
|
82 Ibyte *host;
|
647
|
83 pid_t pid;
|
428
|
84 } lock_info_type;
|
|
85
|
|
86 /* When we read the info back, we might need this much more,
|
|
87 enough for decimal representation plus null. */
|
647
|
88 #define LOCK_PID_MAX (4 * sizeof (pid_t))
|
428
|
89
|
|
90 /* Free the two dynamically-allocated pieces in PTR. */
|
1726
|
91 #define FREE_LOCK_INFO(i) do { \
|
|
92 xfree ((i).user, Ibyte *); \
|
|
93 xfree ((i).host, Ibyte *); \
|
|
94 } while (0)
|
428
|
95
|
|
96 /* Write the name of the lock file for FN into LFNAME. Length will be
|
|
97 that of FN plus two more for the leading `.#' plus one for the null. */
|
|
98 #define MAKE_LOCK_NAME(lock, file) \
|
2367
|
99 (lock = alloca_ibytes (XSTRING_LENGTH (file) + 2 + 1), \
|
771
|
100 fill_in_lock_file_name (lock, file))
|
428
|
101
|
|
102 static void
|
867
|
103 fill_in_lock_file_name (Ibyte *lockfile, Lisp_Object fn)
|
428
|
104 {
|
867
|
105 Ibyte *file_name = XSTRING_DATA (fn);
|
|
106 Ibyte *p;
|
647
|
107 Bytecount dirlen;
|
428
|
108
|
442
|
109 for (p = file_name + XSTRING_LENGTH (fn) - 1;
|
|
110 p > file_name && !IS_ANY_SEP (p[-1]);
|
|
111 p--)
|
|
112 ;
|
|
113 dirlen = p - file_name;
|
428
|
114
|
442
|
115 memcpy (lockfile, file_name, dirlen);
|
|
116 p = lockfile + dirlen;
|
|
117 *(p++) = '.';
|
|
118 *(p++) = '#';
|
|
119 memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen + 1);
|
428
|
120 }
|
|
121
|
|
122 /* Lock the lock file named LFNAME.
|
|
123 If FORCE is nonzero, we do so even if it is already locked.
|
|
124 Return 1 if successful, 0 if not. */
|
|
125
|
|
126 static int
|
867
|
127 lock_file_1 (Ibyte *lfname, int force)
|
428
|
128 {
|
442
|
129 /* Does not GC. */
|
|
130 int err;
|
867
|
131 Ibyte *lock_info_str;
|
|
132 Ibyte *host_name;
|
|
133 Ibyte *user_name = user_login_name (NULL);
|
428
|
134
|
442
|
135 if (user_name == NULL)
|
867
|
136 user_name = (Ibyte *) "";
|
442
|
137
|
|
138 if (STRINGP (Vsystem_name))
|
771
|
139 host_name = XSTRING_DATA (Vsystem_name);
|
428
|
140 else
|
867
|
141 host_name = (Ibyte *) "";
|
442
|
142
|
771
|
143 lock_info_str =
|
2367
|
144 alloca_ibytes (qxestrlen (user_name) + qxestrlen (host_name)
|
|
145 + LOCK_PID_MAX + 5);
|
428
|
146
|
771
|
147 qxesprintf (lock_info_str, "%s@%s.%d", user_name, host_name, qxe_getpid ());
|
428
|
148
|
771
|
149 err = qxe_symlink (lock_info_str, lfname);
|
442
|
150 if (err != 0 && errno == EEXIST && force)
|
428
|
151 {
|
771
|
152 qxe_unlink (lfname);
|
|
153 err = qxe_symlink (lock_info_str, lfname);
|
428
|
154 }
|
|
155
|
|
156 return err == 0;
|
|
157 }
|
|
158
|
|
159 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
|
|
160 1 if another process owns it (and set OWNER (if non-null) to info),
|
|
161 2 if the current process owns it,
|
|
162 or -1 if something is wrong with the locking mechanism. */
|
|
163
|
|
164 static int
|
867
|
165 current_lock_owner (lock_info_type *owner, Ibyte *lfname)
|
428
|
166 {
|
442
|
167 /* Does not GC. */
|
|
168 int len, ret;
|
428
|
169 int local_owner = 0;
|
867
|
170 Ibyte *at, *dot;
|
|
171 Ibyte *lfinfo = 0;
|
428
|
172 int bufsize = 50;
|
|
173 /* Read arbitrarily-long contents of symlink. Similar code in
|
|
174 file-symlink-p in fileio.c. */
|
|
175 do
|
|
176 {
|
|
177 bufsize *= 2;
|
867
|
178 lfinfo = (Ibyte *) xrealloc (lfinfo, bufsize);
|
771
|
179 len = qxe_readlink (lfname, lfinfo, bufsize);
|
428
|
180 }
|
|
181 while (len >= bufsize);
|
442
|
182
|
428
|
183 /* If nonexistent lock file, all is well; otherwise, got strange error. */
|
|
184 if (len == -1)
|
|
185 {
|
1726
|
186 xfree (lfinfo, Ibyte *);
|
428
|
187 return errno == ENOENT ? 0 : -1;
|
|
188 }
|
|
189
|
|
190 /* Link info exists, so `len' is its length. Null terminate. */
|
|
191 lfinfo[len] = 0;
|
442
|
192
|
428
|
193 /* Even if the caller doesn't want the owner info, we still have to
|
|
194 read it to determine return value, so allocate it. */
|
|
195 if (!owner)
|
|
196 {
|
2367
|
197 owner = alloca_new (lock_info_type);
|
428
|
198 local_owner = 1;
|
|
199 }
|
442
|
200
|
428
|
201 /* Parse USER@HOST.PID. If can't parse, return -1. */
|
|
202 /* The USER is everything before the first @. */
|
771
|
203 at = qxestrchr (lfinfo, '@');
|
|
204 dot = qxestrrchr (lfinfo, '.');
|
428
|
205 if (!at || !dot) {
|
1726
|
206 xfree (lfinfo, Ibyte *);
|
428
|
207 return -1;
|
|
208 }
|
|
209 len = at - lfinfo;
|
2367
|
210 owner->user = xnew_ibytes (len + 1);
|
771
|
211 qxestrncpy (owner->user, lfinfo, len);
|
428
|
212 owner->user[len] = 0;
|
442
|
213
|
428
|
214 /* The PID is everything after the last `.'. */
|
867
|
215 owner->pid = atoi ((CIbyte *) dot + 1);
|
428
|
216
|
|
217 /* The host is everything in between. */
|
|
218 len = dot - at - 1;
|
2367
|
219 owner->host = xnew_ibytes (len + 1);
|
771
|
220 qxestrncpy (owner->host, at + 1, len);
|
428
|
221 owner->host[len] = 0;
|
|
222
|
|
223 /* We're done looking at the link info. */
|
1726
|
224 xfree (lfinfo, Ibyte *);
|
442
|
225
|
428
|
226 /* On current host? */
|
442
|
227 if (STRINGP (Fsystem_name ())
|
771
|
228 && qxestrcmp (owner->host, XSTRING_DATA (Fsystem_name ())) == 0)
|
428
|
229 {
|
771
|
230 if (owner->pid == qxe_getpid ())
|
428
|
231 ret = 2; /* We own it. */
|
|
232 else if (owner->pid > 0
|
|
233 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
|
|
234 ret = 1; /* An existing process on this machine owns it. */
|
|
235 /* The owner process is dead or has a strange pid (<=0), so try to
|
|
236 zap the lockfile. */
|
771
|
237 else if (qxe_unlink (lfname) < 0)
|
428
|
238 ret = -1;
|
|
239 else
|
|
240 ret = 0;
|
|
241 }
|
|
242 else
|
|
243 { /* If we wanted to support the check for stale locks on remote machines,
|
|
244 here's where we'd do it. */
|
|
245 ret = 1;
|
|
246 }
|
442
|
247
|
428
|
248 /* Avoid garbage. */
|
|
249 if (local_owner || ret <= 0)
|
|
250 {
|
|
251 FREE_LOCK_INFO (*owner);
|
|
252 }
|
|
253 return ret;
|
|
254 }
|
|
255
|
|
256 /* Lock the lock named LFNAME if possible.
|
|
257 Return 0 in that case.
|
|
258 Return positive if some other process owns the lock, and info about
|
|
259 that process in CLASHER.
|
|
260 Return -1 if cannot lock for any other reason. */
|
|
261
|
|
262 static int
|
867
|
263 lock_if_free (lock_info_type *clasher, Ibyte *lfname)
|
428
|
264 {
|
442
|
265 /* Does not GC. */
|
867
|
266 if (lock_file_1 ((Ibyte *) lfname, 0) == 0)
|
428
|
267 {
|
|
268 int locker;
|
|
269
|
|
270 if (errno != EEXIST)
|
|
271 return -1;
|
442
|
272
|
428
|
273 locker = current_lock_owner (clasher, lfname);
|
|
274 if (locker == 2)
|
|
275 {
|
|
276 FREE_LOCK_INFO (*clasher);
|
|
277 return 0; /* We ourselves locked it. */
|
|
278 }
|
|
279 else if (locker == 1)
|
|
280 return 1; /* Someone else has it. */
|
|
281
|
|
282 return -1; /* Something's wrong. */
|
|
283 }
|
|
284 return 0;
|
|
285 }
|
|
286
|
|
287 /* lock_file locks file FN,
|
|
288 meaning it serves notice on the world that you intend to edit that file.
|
|
289 This should be done only when about to modify a file-visiting
|
|
290 buffer previously unmodified.
|
|
291 Do not (normally) call this for a buffer already modified,
|
|
292 as either the file is already locked, or the user has already
|
|
293 decided to go ahead without locking.
|
|
294
|
|
295 When this returns, either the lock is locked for us,
|
|
296 or the user has said to go ahead without locking.
|
|
297
|
|
298 If the file is locked by someone else, this calls
|
|
299 ask-user-about-lock (a Lisp function) with two arguments,
|
|
300 the file name and info about the user who did the locking.
|
|
301 This function can signal an error, or return t meaning
|
|
302 take away the lock, or return nil meaning ignore the lock. */
|
|
303
|
|
304 void
|
|
305 lock_file (Lisp_Object fn)
|
|
306 {
|
442
|
307 /* This function can GC. GC checked 7-11-00 ben */
|
428
|
308 /* dmoore - and can destroy current_buffer and all sorts of other
|
|
309 mean nasty things with pointy teeth. If you call this make sure
|
|
310 you protect things right. */
|
442
|
311 /* Somebody updated the code in this function and removed the previous
|
428
|
312 comment. -slb */
|
|
313
|
|
314 register Lisp_Object attack, orig_fn;
|
867
|
315 register Ibyte *lfname, *locker;
|
428
|
316 lock_info_type lock_info;
|
444
|
317 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
318 Lisp_Object old_current_buffer;
|
428
|
319 Lisp_Object subject_buf;
|
|
320
|
444
|
321 if (inhibit_clash_detection)
|
|
322 return;
|
|
323
|
793
|
324 old_current_buffer = wrap_buffer (current_buffer);
|
446
|
325 subject_buf = Qnil;
|
444
|
326 GCPRO3 (fn, subject_buf, old_current_buffer);
|
428
|
327 orig_fn = fn;
|
|
328 fn = Fexpand_file_name (fn, Qnil);
|
|
329
|
|
330 /* Create the name of the lock-file for file fn */
|
|
331 MAKE_LOCK_NAME (lfname, fn);
|
|
332
|
|
333 /* See if this file is visited and has changed on disk since it was
|
|
334 visited. */
|
|
335 {
|
|
336 subject_buf = get_truename_buffer (orig_fn);
|
|
337 if (!NILP (subject_buf)
|
|
338 && NILP (Fverify_visited_file_modtime (subject_buf))
|
|
339 && !NILP (Ffile_exists_p (fn)))
|
442
|
340 call1_in_buffer (XBUFFER (subject_buf),
|
|
341 Qask_user_about_supersession_threat, fn);
|
428
|
342 }
|
|
343
|
|
344 /* Try to lock the lock. */
|
444
|
345 if (current_buffer != XBUFFER (old_current_buffer)
|
|
346 || lock_if_free (&lock_info, lfname) <= 0)
|
|
347 /* Return now if we have locked it, or if lock creation failed
|
|
348 or current buffer is killed. */
|
428
|
349 goto done;
|
|
350
|
|
351 /* Else consider breaking the lock */
|
2367
|
352 locker = alloca_ibytes (qxestrlen (lock_info.user)
|
|
353 + qxestrlen (lock_info.host)
|
|
354 + LOCK_PID_MAX + 9);
|
771
|
355 qxesprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
|
|
356 lock_info.pid);
|
428
|
357 FREE_LOCK_INFO (lock_info);
|
442
|
358
|
428
|
359 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
|
|
360 current_buffer, Qask_user_about_lock , fn,
|
771
|
361 build_intstring (locker));
|
444
|
362 if (!NILP (attack) && current_buffer == XBUFFER (old_current_buffer))
|
428
|
363 /* User says take the lock */
|
|
364 {
|
|
365 lock_file_1 (lfname, 1);
|
|
366 goto done;
|
|
367 }
|
|
368 /* User says ignore the lock */
|
|
369 done:
|
|
370 UNGCPRO;
|
|
371 }
|
|
372
|
|
373 void
|
|
374 unlock_file (Lisp_Object fn)
|
|
375 {
|
442
|
376 /* This can GC */
|
867
|
377 register Ibyte *lfname;
|
442
|
378 struct gcpro gcpro1;
|
|
379
|
|
380 GCPRO1 (fn);
|
428
|
381
|
|
382 fn = Fexpand_file_name (fn, Qnil);
|
|
383
|
|
384 MAKE_LOCK_NAME (lfname, fn);
|
|
385
|
|
386 if (current_lock_owner (0, lfname) == 2)
|
771
|
387 qxe_unlink (lfname);
|
442
|
388
|
|
389 UNGCPRO;
|
428
|
390 }
|
|
391
|
|
392 void
|
442
|
393 unlock_all_files (void)
|
428
|
394 {
|
|
395 register Lisp_Object tail;
|
|
396
|
434
|
397 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
|
428
|
398 {
|
442
|
399 struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
|
428
|
400 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
|
|
401 unlock_file (b->file_truename);
|
|
402 }
|
|
403 }
|
|
404
|
|
405 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
|
442
|
406 Lock FILE, if current buffer is modified.
|
|
407 FILE defaults to current buffer's visited file,
|
428
|
408 or else nothing is done if current buffer isn't visiting a file.
|
|
409 */
|
442
|
410 (file))
|
428
|
411 {
|
|
412 if (NILP (file))
|
|
413 file = current_buffer->file_truename;
|
|
414 CHECK_STRING (file);
|
|
415 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
|
|
416 && !NILP (file))
|
|
417 lock_file (file);
|
|
418 return Qnil;
|
|
419 }
|
|
420
|
|
421 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
|
|
422 Unlock the file visited in the current buffer,
|
|
423 if it should normally be locked.
|
|
424 */
|
|
425 ())
|
|
426 {
|
|
427 /* This function can GC */
|
|
428 /* dmoore - and can destroy current_buffer and all sorts of other
|
|
429 mean nasty things with pointy teeth. If you call this make sure
|
|
430 you protect things right. */
|
|
431
|
|
432 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
|
|
433 && STRINGP (current_buffer->file_truename))
|
|
434 unlock_file (current_buffer->file_truename);
|
|
435 return Qnil;
|
|
436 }
|
|
437
|
|
438 /* Unlock the file visited in buffer BUFFER. */
|
|
439
|
|
440
|
|
441 void
|
|
442 unlock_buffer (struct buffer *buffer)
|
|
443 {
|
|
444 /* This function can GC */
|
|
445 /* dmoore - and can destroy current_buffer and all sorts of other
|
|
446 mean nasty things with pointy teeth. If you call this make sure
|
|
447 you protect things right. */
|
|
448 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
|
|
449 && STRINGP (buffer->file_truename))
|
|
450 unlock_file (buffer->file_truename);
|
|
451 }
|
|
452
|
|
453 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
|
442
|
454 Return nil if the FILENAME is not locked,
|
428
|
455 t if it is locked by you, else a string of the name of the locker.
|
|
456 */
|
442
|
457 (filename))
|
428
|
458 {
|
|
459 Lisp_Object ret;
|
867
|
460 register Ibyte *lfname;
|
428
|
461 int owner;
|
|
462 lock_info_type locker;
|
442
|
463 struct gcpro gcpro1;
|
|
464
|
|
465 GCPRO1 (filename);
|
428
|
466
|
|
467 filename = Fexpand_file_name (filename, Qnil);
|
|
468
|
|
469 MAKE_LOCK_NAME (lfname, filename);
|
|
470
|
|
471 owner = current_lock_owner (&locker, lfname);
|
|
472 if (owner <= 0)
|
|
473 ret = Qnil;
|
|
474 else if (owner == 2)
|
|
475 ret = Qt;
|
|
476 else
|
771
|
477 ret = build_intstring (locker.user);
|
428
|
478
|
|
479 if (owner > 0)
|
|
480 FREE_LOCK_INFO (locker);
|
|
481
|
442
|
482 UNGCPRO;
|
|
483
|
428
|
484 return ret;
|
|
485 }
|
|
486
|
|
487
|
|
488 /* Initialization functions. */
|
|
489
|
|
490 void
|
|
491 syms_of_filelock (void)
|
|
492 {
|
|
493 /* This function can GC */
|
|
494 DEFSUBR (Funlock_buffer);
|
|
495 DEFSUBR (Flock_buffer);
|
|
496 DEFSUBR (Ffile_locked_p);
|
|
497
|
563
|
498 DEFSYMBOL (Qask_user_about_supersession_threat);
|
|
499 DEFSYMBOL (Qask_user_about_lock);
|
428
|
500 }
|
|
501
|
444
|
502 void
|
|
503 vars_of_filelock (void)
|
|
504 {
|
|
505 DEFVAR_BOOL ("inhibit-clash-detection", &inhibit_clash_detection /*
|
|
506 Non-nil inhibits creation of lock file to detect clash.
|
|
507 */);
|
|
508 inhibit_clash_detection = 0;
|
|
509 }
|
428
|
510
|
|
511 #endif /* CLASH_DETECTION */
|