Mercurial > hg > xemacs-beta
annotate src/filelock.c @ 4964:1f509f82c8c9
fix compile error
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* alloc.c (common_init_alloc_early):
Fix compiler breakage.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 01 Feb 2010 13:35:15 -0600 |
parents | 304aebb79cd3 |
children | c448f4c38d65 |
rev | line source |
---|---|
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, | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2367
diff
changeset
|
361 build_istring (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 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2367
diff
changeset
|
477 ret = build_istring (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 */ |