annotate src/filelock.c @ 1279:cd0abfdb9e9d

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