Mercurial > hg > xemacs-beta

comparison src/filelock.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
2 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: FSF 19.30. */
22
23 #include <config.h>
24 #include "lisp.h"
25
26 #include "buffer.h"
27 #include "paths.h"
28
29 #include "sysfile.h"
30 #include "sysdir.h"
31 #include "syspwd.h"
32 #include "syssignal.h" /* for kill */
33
34
35 #ifdef CLASH_DETECTION
36
37 /* FSFmacs uses char *lock_dir and char *superlock_file instead of
38 the Lisp variables we use. */
39
40 /* The name of the directory in which we keep lock files, with a '/'
41 appended. */
42 Lisp_Object Vlock_directory;
43
44 #if 0 /* FSFmacs */
45 /* Look in startup.el */
46 /* The name of the file in the lock directory which is used to
47 arbitrate access to the entire directory. */
48 #define SUPERLOCK_NAME "!!!SuperLock!!!"
49 #endif
50
51 /* The name of the superlock file. This is SUPERLOCK_NAME appended to
52 Vlock_directory. */
53 Lisp_Object Vsuperlock_file;
54
55 Lisp_Object Qask_user_about_supersession_threat;
56 Lisp_Object Qask_user_about_lock;
57
58 static void lock_superlock (CONST char *lfname);
59 static int lock_file_1 (CONST char *lfname, int mode);
60 static int lock_if_free (CONST char *lfname);
61 static int current_lock_owner (CONST char *);
62 static int current_lock_owner_1 (CONST char *);
63
64 /* Set LOCK to the name of the lock file for the filename FILE.
65 char *LOCK; Lisp_Object FILE;
66
67 MAKE_LOCK_NAME assumes you have already verified that Vlock_directory
68 is a string. */
69
70 #ifndef HAVE_LONG_FILE_NAMES
71
72 #define MAKE_LOCK_NAME(lock, file) \
73 (lock = (char *) alloca (14 + string_length (XSTRING (Vlock_directory)) + \
74 1), \
75 fill_in_lock_short_file_name (lock, (file)))
76
77 static void
78 fill_in_lock_short_file_name (REGISTER char *lockfile, REGISTER Lisp_Object fn)
79 {
80 REGISTER union
81 {
82 unsigned int word [2];
83 unsigned char byte [8];
84 } crc;
85 REGISTER unsigned char *p, new;
86
87 CHECK_STRING (Vlock_directory);
88
89 /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
90 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
91
92 crc.word[0] = crc.word[1] = 0;
93
94 for (p = string_data (XSTRING (fn)); new = *p++; )
95 {
96 new += crc.byte[6];
97 crc.byte[6] = crc.byte[5] + new;
98 crc.byte[5] = crc.byte[4];
99 crc.byte[4] = crc.byte[3];
100 crc.byte[3] = crc.byte[2] + new;
101 crc.byte[2] = crc.byte[1];
102 crc.byte[1] = crc.byte[0];
103 crc.byte[0] = new;
104 }
105
106 {
107 int need_slash = 0;
108
109 /* in case lock-directory doesn't end in / */
110 if (string_byte (XSTRING (Vlock_directory),
111 string_length (XSTRING (Vlock_directory)) - 1) != '/')
112 need_slash = 1;
113
114 sprintf (lockfile, "%s%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x",
115 (char *) string_data (XSTRING (Vlock_directory)),
116 need_slash ? "/" : "",
117 crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3],
118 crc.byte[4], crc.byte[5], crc.byte[6]);
119 }
120 }
121
122 #else /* defined HAVE_LONG_FILE_NAMES */
123
124 /* +2 for terminating null and possible extra slash */
125 #define MAKE_LOCK_NAME(lock, file) \
126 (lock = (char *) alloca (string_length (XSTRING (file)) + \
127 string_length (XSTRING (Vlock_directory)) + 2), \
128 fill_in_lock_file_name (lock, (file)))
129
130 static void
131 fill_in_lock_file_name (REGISTER char *lockfile, REGISTER Lisp_Object fn)
132 /* fn must be a Lisp_String! */
133 {
134 REGISTER char *p;
135
136 CHECK_STRING (Vlock_directory);
137
138 strcpy (lockfile, (char *) string_data (XSTRING (Vlock_directory)));
139
140 p = lockfile + strlen (lockfile);
141
142 if (p == lockfile /* lock-directory is empty?? */
143 || *(p - 1) != '/') /* in case lock-directory doesn't end in / */
144 {
145 *p = '/';
146 p++;
147 }
148
149 strcpy (p, (char *) string_data (XSTRING (fn)));
150
151 for (; *p; p++)
152 {
153 if (*p == '/')
154 *p = '!';
155 }
156 }
157 #endif /* !defined HAVE_LONG_FILE_NAMES */
158
159 static Lisp_Object
160 lock_file_owner_name (CONST char *lfname)
161 {
162 struct stat s;
163 struct passwd *the_pw = 0;
164
165 if (lstat (lfname, &s) == 0)
166 the_pw = getpwuid (s.st_uid);
167 return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
168 }
169
170
171 /* lock_file locks file fn,
172 meaning it serves notice on the world that you intend to edit that file.
173 This should be done only when about to modify a file-visiting
174 buffer previously unmodified.
175 Do not (normally) call lock_buffer for a buffer already modified,
176 as either the file is already locked, or the user has already
177 decided to go ahead without locking.
178
179 When lock_buffer returns, either the lock is locked for us,
180 or the user has said to go ahead without locking.
181
182 If the file is locked by someone else, lock_buffer calls
183 ask-user-about-lock (a Lisp function) with two arguments,
184 the file name and the name of the user who did the locking.
185 This function can signal an error, or return t meaning
186 take away the lock, or return nil meaning ignore the lock. */
187
188 /* The lock file name is the file name with "/" replaced by "!"
189 and put in the Emacs lock directory. */
190 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
191
192 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
193 representation of a 14-bytes CRC generated from the file name
194 and put in the Emacs lock directory (not very nice, but it works).
195 (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
196
197 void
198 lock_file (Lisp_Object fn)
199 {
200 /* This function can GC */
201 REGISTER Lisp_Object attack, orig_fn;
202 REGISTER char *lfname;
203 struct gcpro gcpro1, gcpro2;
204 Lisp_Object subject_buf = Qnil;
205
206 if (NILP (Vlock_directory) || NILP (Vsuperlock_file))
207 return;
208 CHECK_STRING (fn);
209 CHECK_STRING (Vlock_directory);
210
211 GCPRO2 (fn, subject_buf);
212 orig_fn = fn;
213 fn = Fexpand_file_name (fn, Qnil);
214
215 /* Create the name of the lock-file for file fn */
216 MAKE_LOCK_NAME (lfname, fn);
217
218 /* See if this file is visited and has changed on disk since it was
219 visited. */
220 subject_buf = Fget_file_buffer (fn);
221 if (!NILP (subject_buf)
222 && NILP (Fverify_visited_file_modtime (subject_buf))
223 && !NILP (Ffile_exists_p (fn)))
224 call1_in_buffer (XBUFFER (subject_buf),
225 Qask_user_about_supersession_threat, fn);
226
227 /* Try to lock the lock. */
228 if (lock_if_free (lfname) <= 0)
229 /* Return now if we have locked it, or if lock dir does not exist */
230 goto done;
231
232 /* Else consider breaking the lock */
233 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
234 current_buffer, Qask_user_about_lock, fn,
235 lock_file_owner_name (lfname));
236 if (!NILP (attack))
237 /* User says take the lock */
238 {
239 CHECK_STRING (Vsuperlock_file);
240 lock_superlock (lfname);
241 lock_file_1 (lfname, O_WRONLY);
242 unlink ((char *) string_data (XSTRING (Vsuperlock_file)));
243 goto done;
244 }
245 /* User says ignore the lock */
246 done:
247 UNGCPRO;
248 }
249
250
251 /* Lock the lock file named LFNAME.
252 If MODE is O_WRONLY, we do so even if it is already locked.
253 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
254 Return 1 if successful, 0 if not. */
255
256 static int
257 lock_file_1 (CONST char *lfname, int mode)
258 {
259 REGISTER int fd;
260 char buf[20];
261
262 if ((fd = open (lfname, mode, 0666)) >= 0)
263 {
264 #ifdef USG
265 chmod (lfname, 0666);
266 #else
267 fchmod (fd, 0666);
268 #endif
269 sprintf (buf, "%ld ", (long) getpid ());
270 write (fd, buf, strlen (buf));
271 close (fd);
272 return 1;
273 }
274 else
275 return 0;
276 }
277
278 /* Lock the lock named LFNAME if possible.
279 Return 0 in that case.
280 Return positive if lock is really locked by someone else.
281 Return -1 if cannot lock for any other reason. */
282
283 static int
284 lock_if_free (CONST char *lfname)
285 {
286 REGISTER int clasher;
287
288 while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
289 {
290 if (errno != EEXIST)
291 return -1;
292 clasher = current_lock_owner (lfname);
293 if (clasher != 0)
294 if (clasher != getpid ())
295 return (clasher);
296 else return (0);
297 /* Try again to lock it */
298 }
299 return 0;
300 }
301
302 /* Return the pid of the process that claims to own the lock file LFNAME,
303 or 0 if nobody does or the lock is obsolete,
304 or -1 if something is wrong with the locking mechanism. */
305
306 static int
307 current_lock_owner (CONST char *lfname)
308 {
309 int owner = current_lock_owner_1 (lfname);
310 if (owner == 0 && errno == ENOENT)
311 return (0);
312 /* Is it locked by a process that exists? */
313 if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
314 return (owner);
315 if (unlink (lfname) < 0)
316 return (-1);
317 return (0);
318 }
319
320 static int
321 current_lock_owner_1 (CONST char *lfname)
322 {
323 REGISTER int fd;
324 char buf[20];
325 int tem;
326
327 fd = open (lfname, O_RDONLY, 0666);
328 if (fd < 0)
329 return 0;
330 tem = read (fd, buf, sizeof buf);
331 close (fd);
332 return (tem <= 0 ? 0 : atoi (buf));
333 }
334
335
336 void
337 unlock_file (Lisp_Object fn)
338 {
339 REGISTER char *lfname;
340 if (NILP (Vlock_directory) || NILP (Vsuperlock_file)) return;
341 CHECK_STRING (fn);
342 CHECK_STRING (Vlock_directory);
343 CHECK_STRING (Vsuperlock_file);
344
345 fn = Fexpand_file_name (fn, Qnil);
346
347 MAKE_LOCK_NAME (lfname, fn);
348
349 lock_superlock (lfname);
350
351 if (current_lock_owner_1 (lfname) == getpid ())
352 unlink (lfname);
353
354 unlink ((char *) string_data (XSTRING (Vsuperlock_file)));
355 }
356
357 static void
358 lock_superlock (CONST char *lfname)
359 {
360 REGISTER int i, fd;
361 DIR *lockdir;
362
363 for (i = -20; i < 0 &&
364 (fd = open ((char *) string_data (XSTRING (Vsuperlock_file)),
365 O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
366 i++)
367 {
368 if (errno != EEXIST)
369 return;
370
371 /* This seems to be necessary to prevent Emacs from hanging when the
372 competing process has already deleted the superlock, but it's still
373 in the NFS cache. So we force NFS to synchronize the cache. */
374 lockdir = opendir ((char *) string_data (XSTRING (Vlock_directory)));
375 if (lockdir)
376 closedir (lockdir);
377
378 emacs_sleep (1);
379 }
380 if (fd >= 0)
381 {
382 #ifdef USG
383 chmod ((char *) string_data (XSTRING (Vsuperlock_file)), 0666);
384 #else
385 fchmod (fd, 0666);
386 #endif
387 write (fd, lfname, strlen (lfname));
388 close (fd);
389 }
390 }
391
392 void
393 unlock_all_files (void)
394 {
395 REGISTER Lisp_Object tail;
396 REGISTER struct buffer *b;
397
398 for (tail = Vbuffer_alist; GC_CONSP (tail);
399 tail = XCDR (tail))
400 {
401 b = XBUFFER (XCDR (XCAR (tail)));
402 if (STRINGP (b->file_truename) &&
403 BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
404 unlock_file (b->file_truename);
405 }
406 }
407
408
409 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
410 0, 1, 0 /*
411 Lock FILE, if current buffer is modified.
412 FILE defaults to current buffer's visited file,
413 or else nothing is done if current buffer isn't visiting a file.
414 */ )
415 (fn)
416 Lisp_Object fn;
417 {
418 /* This function can GC */
419 if (NILP (fn))
420 fn = current_buffer->file_truename;
421 CHECK_STRING (fn);
422 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
423 && !NILP (fn))
424 lock_file (fn);
425 return Qnil;
426 }
427
428 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
429 0, 0, 0 /*
430 Unlock the file visited in the current buffer,
431 if it should normally be locked.
432 */ )
433 ()
434 {
435 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
436 && STRINGP (current_buffer->file_truename))
437 unlock_file (current_buffer->file_truename);
438 return Qnil;
439 }
440
441
442 /* Unlock the file visited in buffer BUFFER. */
443
444 void
445 unlock_buffer (struct buffer *buffer)
446 {
447 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
448 && STRINGP (buffer->file_truename))
449 unlock_file (buffer->file_truename);
450 }
451
452 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0 /*
453 Return nil if the FILENAME is not locked,
454 t if it is locked by you, else a string of the name of the locker.
455 */ )
456 (fn)
457 Lisp_Object fn;
458 {
459 /* This function can GC */
460 REGISTER char *lfname;
461 int owner;
462
463 if (NILP (Vlock_directory) || NILP (Vsuperlock_file))
464 return Qnil;
465 CHECK_STRING (Vlock_directory);
466
467 fn = Fexpand_file_name (fn, Qnil);
468
469 MAKE_LOCK_NAME (lfname, fn);
470
471 owner = current_lock_owner (lfname);
472 if (owner <= 0)
473 return (Qnil);
474 else if (owner == getpid ())
475 return (Qt);
476
477 return (lock_file_owner_name (lfname));
478 }
479
480 void
481 syms_of_filelock (void)
482 {
483 /* This function can GC */
484 defsubr (&Sunlock_buffer);
485 defsubr (&Slock_buffer);
486 defsubr (&Sfile_locked_p);
487
488 defsymbol (&Qask_user_about_supersession_threat,
489 "ask-user-about-supersession-threat");
490 defsymbol (&Qask_user_about_lock, "ask-user-about-lock");
491 }
492
493 void
494 vars_of_filelock (void)
495 {
496 DEFVAR_LISP ("lock-directory", &Vlock_directory /*
497 Don't change this
498 */ );
499 DEFVAR_LISP ("superlock-file", &Vsuperlock_file /*
500 Don't change this
501 */ );
502 }
503
504 void
505 complex_vars_of_filelock (void)
506 {
507 #ifdef PATH_LOCK
508 Vlock_directory =
509 Ffile_name_as_directory (build_string (PATH_LOCK));
510 #else
511 Vlock_directory = Qnil;
512 #endif
513 #ifdef PATH_SUPERLOCK
514 Vsuperlock_file =
515 Ffile_name_as_directory (build_string (PATH_SUPERLOCK));
516 #else
517 Vsuperlock_file = Qnil;
518 #endif
519 /* All the rest done dynamically by startup.el */
520 }
521
522 #endif /* CLASH_DETECTION */