16802
|
1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
|
163
|
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
|
624
|
7 the Free Software Foundation; either version 2, or (at your option)
|
163
|
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
|
14186
|
17 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
18 Boston, MA 02111-1307, USA. */
|
163
|
19
|
|
20
|
|
21 #include <sys/types.h>
|
|
22 #include <sys/stat.h>
|
4696
|
23 #include <config.h>
|
372
|
24
|
|
25 #ifdef VMS
|
559
|
26 #include "vms-pwd.h"
|
372
|
27 #else
|
163
|
28 #include <pwd.h>
|
16802
|
29 #endif /* not VMS */
|
372
|
30
|
163
|
31 #include <sys/file.h>
|
|
32 #ifdef USG
|
|
33 #include <fcntl.h>
|
16802
|
34 #include <string.h>
|
163
|
35 #endif /* USG */
|
|
36
|
|
37 #include "lisp.h"
|
|
38 #include "buffer.h"
|
|
39
|
16802
|
40 #include <errno.h>
|
|
41 #ifndef errno
|
163
|
42 extern int errno;
|
4272
|
43 #endif
|
|
44
|
163
|
45 #ifdef CLASH_DETECTION
|
|
46
|
16802
|
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.
|
163
|
50
|
16802
|
51 When the host in the lock data is the current host, we can check if
|
|
52 the pid is valid with kill.
|
|
53
|
|
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
|
17165
|
61 environment, it seems such stale locks arise fairly infrequently, and
|
16802
|
62 Emacs' standard methods of dealing with clashes suffice.
|
624
|
63
|
16802
|
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
|
17165
|
68 files to be useful on old systems lacking symlinks, nowadays
|
16802
|
69 virtually all such systems are probably single-user anyway, so it
|
|
70 didn't seem worth the complication.
|
|
71
|
|
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
|
|
74 symlinks.
|
|
75
|
|
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.
|
|
79
|
|
80 --karl@cs.umb.edu/karl@hq.ileaf.com. */
|
624
|
81
|
16802
|
82
|
|
83 /* Here is the structure that stores information about a lock. */
|
3537
|
84
|
16802
|
85 typedef struct
|
|
86 {
|
|
87 char *user;
|
|
88 char *host;
|
16816
|
89 unsigned long pid;
|
16802
|
90 } lock_info_type;
|
3537
|
91
|
16844
f919de623142
(LOCK_PID_MAX): Use sizeof (unsigned long) instead of hardwiring 21.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
92 /* When we read the info back, we might need this much more,
|
f919de623142
(LOCK_PID_MAX): Use sizeof (unsigned long) instead of hardwiring 21.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
93 enough for decimal representation plus null. */
|
f919de623142
(LOCK_PID_MAX): Use sizeof (unsigned long) instead of hardwiring 21.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
94 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
|
16802
|
95
|
|
96 /* Free the two dynamically-allocated pieces in PTR. */
|
|
97 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
|
3537
|
98
|
|
99
|
16802
|
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. */
|
9996
|
102 #define MAKE_LOCK_NAME(lock, file) \
|
16802
|
103 (lock = (char *) alloca (XSTRING (file)->size + 2 + 1), \
|
624
|
104 fill_in_lock_file_name (lock, (file)))
|
|
105
|
16802
|
106 static void
|
624
|
107 fill_in_lock_file_name (lockfile, fn)
|
|
108 register char *lockfile;
|
|
109 register Lisp_Object fn;
|
|
110 {
|
|
111 register char *p;
|
|
112
|
16802
|
113 strcpy (lockfile, XSTRING (fn)->data);
|
624
|
114
|
16802
|
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--)
|
|
119 p[2] = *p;
|
|
120
|
|
121 /* Insert the `.#'. */
|
|
122 p[1] = '.';
|
|
123 p[2] = '#';
|
624
|
124 }
|
16802
|
125
|
|
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. */
|
624
|
129
|
16802
|
130 static int
|
|
131 lock_file_1 (lfname, force)
|
|
132 char *lfname;
|
|
133 int force;
|
163
|
134 {
|
16802
|
135 register int err;
|
|
136 char *user_name = XSTRING (Fuser_login_name (Qnil))->data;
|
|
137 char *host_name = XSTRING (Fsystem_name ())->data;
|
16844
f919de623142
(LOCK_PID_MAX): Use sizeof (unsigned long) instead of hardwiring 21.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
138 char *lock_info_str = alloca (strlen (user_name) + strlen (host_name)
|
f919de623142
(LOCK_PID_MAX): Use sizeof (unsigned long) instead of hardwiring 21.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
139 + LOCK_PID_MAX + 5);
|
163
|
140
|
16816
|
141 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
|
|
142 (unsigned long) getpid ());
|
15797
|
143
|
16802
|
144 err = symlink (lock_info_str, lfname);
|
|
145 if (errno == EEXIST && force)
|
|
146 {
|
|
147 unlink (lfname);
|
|
148 err = symlink (lock_info_str, lfname);
|
|
149 }
|
|
150
|
|
151 return err == 0;
|
163
|
152 }
|
|
153
|
|
154
|
16802
|
155
|
|
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. */
|
|
160
|
|
161 static int
|
|
162 current_lock_owner (owner, lfname)
|
|
163 lock_info_type *owner;
|
|
164 char *lfname;
|
|
165 {
|
|
166 #ifndef index
|
|
167 extern char *rindex (), *index ();
|
|
168 #endif
|
|
169 int o, p, len, ret;
|
|
170 int local_owner = 0;
|
|
171 char *at, *dot;
|
|
172 char *lfinfo = 0;
|
|
173 int bufsize = 50;
|
|
174 /* Read arbitrarily-long contents of symlink. Similar code in
|
|
175 file-symlink-p in fileio.c. */
|
|
176 do
|
|
177 {
|
|
178 bufsize *= 2;
|
|
179 lfinfo = (char *) xrealloc (lfinfo, bufsize);
|
|
180 len = readlink (lfname, lfinfo, bufsize);
|
|
181 }
|
|
182 while (len >= bufsize);
|
|
183
|
|
184 /* If nonexistent lock file, all is well; otherwise, got strange error. */
|
|
185 if (len == -1)
|
|
186 {
|
|
187 xfree (lfinfo);
|
|
188 return errno == ENOENT ? 0 : -1;
|
|
189 }
|
|
190
|
|
191 /* Link info exists, so `len' is its length. Null terminate. */
|
|
192 lfinfo[len] = 0;
|
|
193
|
|
194 /* Even if the caller doesn't want the owner info, we still have to
|
|
195 read it to determine return value, so allocate it. */
|
|
196 if (!owner)
|
|
197 {
|
|
198 owner = alloca (sizeof (lock_info_type));
|
|
199 local_owner = 1;
|
|
200 }
|
|
201
|
|
202 /* Parse USER@HOST.PID. If can't parse, return -1. */
|
|
203 /* The USER is everything before the first @. */
|
|
204 at = index (lfinfo, '@');
|
|
205 dot = rindex (lfinfo, '.');
|
|
206 if (!at || !dot) {
|
|
207 xfree (lfinfo);
|
|
208 return -1;
|
|
209 }
|
|
210 len = at - lfinfo;
|
|
211 owner->user = (char *) xmalloc (len + 1);
|
|
212 strncpy (owner->user, lfinfo, len);
|
|
213 owner->user[len] = 0;
|
|
214
|
|
215 /* The PID is everything after the last `.'. */
|
|
216 owner->pid = atoi (dot + 1);
|
|
217
|
|
218 /* The host is everything in between. */
|
|
219 len = dot - at - 1;
|
|
220 owner->host = (char *) xmalloc (len + 1);
|
|
221 strncpy (owner->host, at + 1, len);
|
|
222 owner->host[len] = 0;
|
|
223
|
|
224 /* We're done looking at the link info. */
|
|
225 xfree (lfinfo);
|
|
226
|
|
227 /* On current host? */
|
|
228 if (strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
|
|
229 {
|
|
230 if (owner->pid == getpid ())
|
|
231 ret = 2; /* We own it. */
|
|
232
|
|
233 if (owner->pid > 0
|
|
234 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
|
|
235 ret = 1; /* An existing process on this machine owns it. */
|
|
236
|
|
237 /* The owner process is dead or has a strange pid (<=0), so try to
|
|
238 zap the lockfile. */
|
|
239 if (unlink (lfname) < 0)
|
|
240 ret = -1;
|
|
241
|
|
242 ret = 0;
|
|
243 }
|
|
244 else
|
|
245 { /* If we wanted to support the check for stale locks on remote machines,
|
|
246 here's where we'd do it. */
|
|
247 ret = 1;
|
|
248 }
|
|
249
|
|
250 /* Avoid garbage. */
|
|
251 if (local_owner || ret <= 0)
|
|
252 {
|
|
253 FREE_LOCK_INFO (*owner);
|
|
254 }
|
|
255 return ret;
|
|
256 }
|
|
257
|
|
258
|
|
259 /* Lock the lock named LFNAME if possible.
|
|
260 Return 0 in that case.
|
|
261 Return positive if some other process owns the lock, and info about
|
|
262 that process in CLASHER.
|
|
263 Return -1 if cannot lock for any other reason. */
|
|
264
|
|
265 static int
|
|
266 lock_if_free (clasher, lfname)
|
|
267 lock_info_type *clasher;
|
|
268 register char *lfname;
|
|
269 {
|
|
270 while (lock_file_1 (lfname, 0) == 0)
|
|
271 {
|
|
272 int locker;
|
|
273
|
|
274 if (errno != EEXIST)
|
|
275 return -1;
|
|
276
|
|
277 locker = current_lock_owner (clasher, lfname);
|
|
278 if (locker == 2)
|
|
279 {
|
|
280 FREE_LOCK_INFO (*clasher);
|
|
281 return 0; /* We ourselves locked it. */
|
|
282 }
|
|
283 else if (locker == 1)
|
|
284 return 1; /* Someone else has it. */
|
|
285 else if (locker == -1)
|
|
286 return -1; /* Something's wrong. */
|
|
287
|
|
288 /* If some other error, or no such lock, try to lock again. */
|
|
289 /* Is there a case where we loop forever? */
|
|
290 }
|
|
291 return 0;
|
|
292 }
|
|
293
|
|
294 /* lock_file locks file FN,
|
163
|
295 meaning it serves notice on the world that you intend to edit that file.
|
|
296 This should be done only when about to modify a file-visiting
|
|
297 buffer previously unmodified.
|
16802
|
298 Do not (normally) call this for a buffer already modified,
|
163
|
299 as either the file is already locked, or the user has already
|
|
300 decided to go ahead without locking.
|
|
301
|
16802
|
302 When this returns, either the lock is locked for us,
|
163
|
303 or the user has said to go ahead without locking.
|
|
304
|
16802
|
305 If the file is locked by someone else, this calls
|
163
|
306 ask-user-about-lock (a Lisp function) with two arguments,
|
16802
|
307 the file name and info about the user who did the locking.
|
163
|
308 This function can signal an error, or return t meaning
|
|
309 take away the lock, or return nil meaning ignore the lock. */
|
|
310
|
|
311 void
|
|
312 lock_file (fn)
|
16802
|
313 register Lisp_Object fn;
|
163
|
314 {
|
12811
|
315 register Lisp_Object attack, orig_fn;
|
16802
|
316 register char *lfname, *locker;
|
|
317 lock_info_type lock_info;
|
163
|
318
|
12811
|
319 orig_fn = fn;
|
12104
|
320 fn = Fexpand_file_name (fn, Qnil);
|
|
321
|
16802
|
322 /* Create the name of the lock-file for file fn */
|
9996
|
323 MAKE_LOCK_NAME (lfname, fn);
|
163
|
324
|
624
|
325 /* See if this file is visited and has changed on disk since it was
|
|
326 visited. */
|
163
|
327 {
|
6499
|
328 register Lisp_Object subject_buf;
|
12811
|
329 subject_buf = get_truename_buffer (orig_fn);
|
485
|
330 if (!NILP (subject_buf)
|
|
331 && NILP (Fverify_visited_file_modtime (subject_buf))
|
|
332 && !NILP (Ffile_exists_p (fn)))
|
163
|
333 call1 (intern ("ask-user-about-supersession-threat"), fn);
|
|
334 }
|
|
335
|
|
336 /* Try to lock the lock. */
|
16802
|
337 if (lock_if_free (&lock_info, lfname) <= 0)
|
|
338 /* Return now if we have locked it, or if lock creation failed */
|
163
|
339 return;
|
|
340
|
|
341 /* Else consider breaking the lock */
|
16802
|
342 locker = alloca (strlen (lock_info.user) + strlen (lock_info.host)
|
|
343 + LOCK_PID_MAX + 9);
|
|
344 sprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
|
|
345 lock_info.pid);
|
|
346 FREE_LOCK_INFO (lock_info);
|
|
347
|
|
348 attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
|
485
|
349 if (!NILP (attack))
|
163
|
350 /* User says take the lock */
|
|
351 {
|
16802
|
352 lock_file_1 (lfname, 1);
|
163
|
353 return;
|
|
354 }
|
|
355 /* User says ignore the lock */
|
|
356 }
|
|
357
|
|
358 void
|
|
359 unlock_file (fn)
|
|
360 register Lisp_Object fn;
|
|
361 {
|
|
362 register char *lfname;
|
|
363
|
12104
|
364 fn = Fexpand_file_name (fn, Qnil);
|
|
365
|
9996
|
366 MAKE_LOCK_NAME (lfname, fn);
|
163
|
367
|
16802
|
368 if (current_lock_owner (0, lfname) == 2)
|
163
|
369 unlink (lfname);
|
|
370 }
|
|
371
|
|
372 void
|
|
373 unlock_all_files ()
|
|
374 {
|
|
375 register Lisp_Object tail;
|
|
376 register struct buffer *b;
|
|
377
|
9949
|
378 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
|
163
|
379 {
|
|
380 b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
|
10752
|
381 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
|
|
382 unlock_file (b->file_truename);
|
163
|
383 }
|
|
384 }
|
|
385
|
|
386 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
|
|
387 0, 1, 0,
|
|
388 "Lock FILE, if current buffer is modified.\n\
|
|
389 FILE defaults to current buffer's visited file,\n\
|
|
390 or else nothing is done if current buffer isn't visiting a file.")
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
391 (file)
|
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
392 Lisp_Object file;
|
163
|
393 {
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
394 if (NILP (file))
|
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
395 file = current_buffer->file_truename;
|
163
|
396 else
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
397 CHECK_STRING (file, 0);
|
10331
|
398 if (SAVE_MODIFF < MODIFF
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
399 && !NILP (file))
|
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
400 lock_file (file);
|
163
|
401 return Qnil;
|
|
402 }
|
|
403
|
|
404 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
|
|
405 0, 0, 0,
|
|
406 "Unlock the file visited in the current buffer,\n\
|
|
407 if it should normally be locked.")
|
|
408 ()
|
|
409 {
|
10331
|
410 if (SAVE_MODIFF < MODIFF
|
10752
|
411 && STRINGP (current_buffer->file_truename))
|
|
412 unlock_file (current_buffer->file_truename);
|
163
|
413 return Qnil;
|
|
414 }
|
|
415
|
|
416 /* Unlock the file visited in buffer BUFFER. */
|
|
417
|
|
418 unlock_buffer (buffer)
|
|
419 struct buffer *buffer;
|
|
420 {
|
10331
|
421 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
|
10752
|
422 && STRINGP (buffer->file_truename))
|
|
423 unlock_file (buffer->file_truename);
|
163
|
424 }
|
|
425
|
|
426 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
|
|
427 "Return nil if the FILENAME is not locked,\n\
|
|
428 t if it is locked by you, else a string of the name of the locker.")
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
429 (filename)
|
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
430 Lisp_Object filename;
|
163
|
431 {
|
16802
|
432 Lisp_Object ret;
|
163
|
433 register char *lfname;
|
|
434 int owner;
|
16802
|
435 lock_info_type locker;
|
163
|
436
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
437 filename = Fexpand_file_name (filename, Qnil);
|
163
|
438
|
14075
21a86b6274e6
(Flock_buffer, Ffile_locked_p): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
diff
changeset
|
439 MAKE_LOCK_NAME (lfname, filename);
|
163
|
440
|
16802
|
441 owner = current_lock_owner (&locker, lfname);
|
163
|
442 if (owner <= 0)
|
16802
|
443 ret = Qnil;
|
|
444 else if (owner == 2)
|
|
445 ret = Qt;
|
|
446 else
|
|
447 ret = build_string (locker.user);
|
|
448
|
|
449 if (owner > 0)
|
|
450 FREE_LOCK_INFO (locker);
|
|
451
|
|
452 return ret;
|
163
|
453 }
|
|
454
|
624
|
455
|
|
456 /* Initialization functions. */
|
|
457
|
|
458 init_filelock ()
|
|
459 {
|
16802
|
460 #if 0
|
10017
|
461 char *new_name;
|
9992
|
462
|
9996
|
463 lock_dir = egetenv ("EMACSLOCKDIR");
|
|
464 if (! lock_dir)
|
|
465 lock_dir = PATH_LOCK;
|
624
|
466
|
9996
|
467 /* Copy the name in case egetenv got it from a Lisp string. */
|
|
468 new_name = (char *) xmalloc (strlen (lock_dir) + 2);
|
|
469 strcpy (new_name, lock_dir);
|
|
470 lock_dir = new_name;
|
9992
|
471
|
624
|
472 /* Make sure it ends with a slash. */
|
9996
|
473 if (lock_dir[strlen (lock_dir) - 1] != '/')
|
|
474 strcat (lock_dir, "/");
|
624
|
475
|
9996
|
476 superlock_file = (char *) xmalloc ((strlen (lock_dir)
|
624
|
477 + sizeof (SUPERLOCK_NAME)));
|
9996
|
478 strcpy (superlock_file, lock_dir);
|
|
479 strcat (superlock_file, SUPERLOCK_NAME);
|
16802
|
480 #endif
|
624
|
481 }
|
|
482
|
163
|
483 syms_of_filelock ()
|
|
484 {
|
|
485 defsubr (&Sunlock_buffer);
|
|
486 defsubr (&Slock_buffer);
|
|
487 defsubr (&Sfile_locked_p);
|
|
488 }
|
|
489
|
|
490 #endif /* CLASH_DETECTION */
|