Mercurial > hg > xemacs-beta

comparison src/filelock.c @ 373:6240c7796c7a r21-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents 70ad99077275
children 064ab7fed2e0
comparison
equal deleted inserted replaced
372:49e1ed2d7ed8 373:6240c7796c7a
1 /* Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994 1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
2 Free Software Foundation, Inc. 2
3 3 This file is part of GNU Emacs.
4 This file is part of XEmacs. 4
5 5 GNU Emacs is free software; you can redistribute it and/or modify
6 XEmacs is free software; you can redistribute it and/or modify it 6 it under the terms of the GNU General Public License as published by
7 under the terms of the GNU General Public License as published by the 7 the Free Software Foundation; either version 2, or (at your option)
8 Free Software Foundation; either version 2, or (at your option) any 8 any later version.
9 later version. 9
10 10 GNU Emacs is distributed in the hope that it will be useful,
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT 11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 GNU General Public License for more details.
14 for more details.
15 14
16 You should have received a copy of the GNU General Public License 15 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to 16 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 17 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 18 Boston, MA 02111-1307, USA. */
20 19
21 /* Synched up with: FSF 19.30. */ 20 /* Synced with FSF 20.2 */
22 21
23 #include <config.h> 22 #include <config.h>
24 #include "lisp.h" 23 #include "lisp.h"
25 24
26 #include "buffer.h" 25 #include "buffer.h"
29 #include "sysfile.h" 28 #include "sysfile.h"
30 #include "sysdir.h" 29 #include "sysdir.h"
31 #include "syspwd.h" 30 #include "syspwd.h"
32 #include "syssignal.h" /* for kill */ 31 #include "syssignal.h" /* for kill */
33 32
34 #ifndef CLASH_DETECTION
35 #error CLASH_DETECTION is not defined??
36 #endif
37
38 /* FSFmacs uses char *lock_dir and char *superlock_file instead of
39 the Lisp variables we use. */
40
41 /* The name of the directory in which we keep lock files, with a '/'
42 appended. */
43 Lisp_Object Vlock_directory;
44
45 #if 0 /* FSFmacs */
46 /* Look in startup.el */
47 /* The name of the file in the lock directory which is used to
48 arbitrate access to the entire directory. */
49 #define SUPERLOCK_NAME "!!!SuperLock!!!"
50 #endif
51
52 /* The name of the superlock file. This is SUPERLOCK_NAME appended to
53 Vlock_directory. */
54 Lisp_Object Vsuperlock_file, Vconfigure_superlock_file;
55
56 Lisp_Object Qask_user_about_supersession_threat; 33 Lisp_Object Qask_user_about_supersession_threat;
57 Lisp_Object Qask_user_about_lock; 34 Lisp_Object Qask_user_about_lock;
58 35
59 static void lock_superlock (CONST char *lfname); 36 #ifdef CLASH_DETECTION
60 static int lock_file_1 (CONST char *lfname, int mode); 37
61 static int lock_if_free (CONST char *lfname); 38 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
62 static int current_lock_owner (CONST char *); 39 directory, with link data `user@host.pid'. This avoids a single
63 static int current_lock_owner_1 (CONST char *); 40 mount (== failure) point for lock files.
64 41
65 /* Set LOCK to the name of the lock file for the filename FILE. 42 When the host in the lock data is the current host, we can check if
66 char *LOCK; Lisp_Object FILE; 43 the pid is valid with kill.
67 44
68 MAKE_LOCK_NAME assumes you have already verified that Vlock_directory 45 Otherwise, we could look at a separate file that maps hostnames to
69 is a string. */ 46 reboot times to see if the remote pid can possibly be valid, since we
70 47 don't want Emacs to have to communicate via pipes or sockets or
71 #ifndef HAVE_LONG_FILE_NAMES 48 whatever to other processes, either locally or remotely; rms says
72 49 that's too unreliable. Hence the separate file, which could
73 #define MAKE_LOCK_NAME(lock, file) \ 50 theoretically be updated by daemons running separately -- but this
74 (lock = (char *) alloca (14 + XSTRING_LENGTH (Vlock_directory) + 1), \ 51 whole idea is unimplemented; in practice, at least in our
75 fill_in_lock_short_file_name (lock, (file))) 52 environment, it seems such stale locks arise fairly infrequently, and
53 Emacs' standard methods of dealing with clashes suffice.
54
55 We use symlinks instead of normal files because (1) they can be
56 stored more efficiently on the filesystem, since the kernel knows
57 they will be small, and (2) all the info about the lock can be read
58 in a single system call (readlink). Although we could use regular
59 files to be useful on old systems lacking symlinks, nowadays
60 virtually all such systems are probably single-user anyway, so it
61 didn't seem worth the complication.
62
63 Similarly, we don't worry about a possible 14-character limit on
64 file names, because those are all the same systems that don't have
65 symlinks.
66
67 This is compatible with the locking scheme used by Interleaf (which
68 has contributed this implementation for Emacs), and was designed by
69 Ethan Jacobson, Kimbo Mundy, and others.
70
71 --karl@cs.umb.edu/karl@hq.ileaf.com. */
72
73
74 /* Here is the structure that stores information about a lock. */
75
76 typedef struct
77 {
78 char *user;
79 char *host;
80 unsigned long pid;
81 } lock_info_type;
82
83 /* When we read the info back, we might need this much more,
84 enough for decimal representation plus null. */
85 #define LOCK_PID_MAX (4 * sizeof (unsigned long))
86
87 /* Free the two dynamically-allocated pieces in PTR. */
88 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
89
90 /* Write the name of the lock file for FN into LFNAME. Length will be
91 that of FN plus two more for the leading `.#' plus one for the null. */
92 #define MAKE_LOCK_NAME(lock, file) \
93 (lock = (char *) alloca (XSTRING_LENGTH(file) + 2 + 1), \
94 fill_in_lock_file_name (lock, (file)))
76 95
77 static void 96 static void
78 fill_in_lock_short_file_name (REGISTER char *lockfile, REGISTER Lisp_Object fn) 97 fill_in_lock_file_name (lockfile, fn)
79 { 98 register char *lockfile;
80 REGISTER union 99 register Lisp_Object fn;
81 { 100 {
82 unsigned int word [2]; 101 register char *p;
83 unsigned char byte [8]; 102
84 } crc; 103 strcpy (lockfile, XSTRING_DATA(fn));
85 REGISTER unsigned char *p, new; 104
86 105 /* Shift the nondirectory part of the file name (including the null)
87 CHECK_STRING (Vlock_directory); 106 right two characters. Here is one of the places where we'd have to
88 107 do something to support 14-character-max file names. */
89 /* 7-bytes cyclic code for burst correction on byte-by-byte basis. 108 for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
90 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */ 109 p[2] = *p;
91 110
92 crc.word[0] = crc.word[1] = 0; 111 /* Insert the `.#'. */
93 112 p[1] = '.';
94 for (p = XSTRING_DATA (fn); new = *p++; ) 113 p[2] = '#';
95 { 114 }
96 new += crc.byte[6]; 115
97 crc.byte[6] = crc.byte[5] + new; 116 /* Lock the lock file named LFNAME.
98 crc.byte[5] = crc.byte[4]; 117 If FORCE is nonzero, we do so even if it is already locked.
99 crc.byte[4] = crc.byte[3]; 118 Return 1 if successful, 0 if not. */
100 crc.byte[3] = crc.byte[2] + new; 119
101 crc.byte[2] = crc.byte[1]; 120 static int
102 crc.byte[1] = crc.byte[0]; 121 lock_file_1 (char *lfname,int force)
103 crc.byte[0] = new; 122 {
104 } 123 register int err;
105 124 char *user_name;
106 { 125 char *host_name;
107 int need_slash = 0; 126 char *lock_info_str;
108 127
109 /* in case lock-directory doesn't end in / */ 128 if (STRINGP (Fuser_login_name (Qnil)))
110 if (XSTRING_BYTE (Vlock_directory, 129 user_name = (char *)XSTRING_DATA((Fuser_login_name (Qnil)));
111 XSTRING_LENGTH (Vlock_directory) - 1) != '/') 130 else
112 need_slash = 1; 131 user_name = "";
113 132 if (STRINGP (Fsystem_name ()))
114 sprintf (lockfile, "%s%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", 133 host_name = (char *)XSTRING_DATA((Fsystem_name ()));
115 (char *) XSTRING_DATA (Vlock_directory), 134 else
116 need_slash ? "/" : "", 135 host_name = "";
117 crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3], 136 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
118 crc.byte[4], crc.byte[5], crc.byte[6]); 137 + LOCK_PID_MAX + 5);
138
139 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
140 (unsigned long) getpid ());
141
142 err = symlink (lock_info_str, lfname);
143 if (errno == EEXIST && force)
144 {
145 unlink (lfname);
146 err = symlink (lock_info_str, lfname);
147 }
148
149 return err == 0;
150 }
151
152 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
153 1 if another process owns it (and set OWNER (if non-null) to info),
154 2 if the current process owns it,
155 or -1 if something is wrong with the locking mechanism. */
156
157 static int
158 current_lock_owner (lock_info_type *owner, char *lfname)
159 {
160 #ifndef index
161 extern char *rindex (), *index ();
162 #endif
163 int o, p, len, ret;
164 int local_owner = 0;
165 char *at, *dot;
166 char *lfinfo = 0;
167 int bufsize = 50;
168 /* Read arbitrarily-long contents of symlink. Similar code in
169 file-symlink-p in fileio.c. */
170 do
171 {
172 bufsize *= 2;
173 lfinfo = (char *) xrealloc (lfinfo, bufsize);
174 len = readlink (lfname, lfinfo, bufsize);
175 }
176 while (len >= bufsize);
177
178 /* If nonexistent lock file, all is well; otherwise, got strange error. */
179 if (len == -1)
180 {
181 xfree (lfinfo);
182 return errno == ENOENT ? 0 : -1;
183 }
184
185 /* Link info exists, so `len' is its length. Null terminate. */
186 lfinfo[len] = 0;
187
188 /* Even if the caller doesn't want the owner info, we still have to
189 read it to determine return value, so allocate it. */
190 if (!owner)
191 {
192 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
193 local_owner = 1;
194 }
195
196 /* Parse USER@HOST.PID. If can't parse, return -1. */
197 /* The USER is everything before the first @. */
198 at = index (lfinfo, '@');
199 dot = rindex (lfinfo, '.');
200 if (!at || !dot) {
201 xfree (lfinfo);
202 return -1;
119 } 203 }
120 } 204 len = at - lfinfo;
121 205 owner->user = (char *) xmalloc (len + 1);
122 #else /* defined HAVE_LONG_FILE_NAMES */ 206 strncpy (owner->user, lfinfo, len);
123 207 owner->user[len] = 0;
124 /* +2 for terminating null and possible extra slash */ 208
125 #define MAKE_LOCK_NAME(lock, file) \ 209 /* The PID is everything after the last `.'. */
126 (lock = (char *) alloca (XSTRING_LENGTH (file) + \ 210 owner->pid = atoi (dot + 1);
127 XSTRING_LENGTH (Vlock_directory) + 2), \ 211
128 fill_in_lock_file_name (lock, (file))) 212 /* The host is everything in between. */
129 213 len = dot - at - 1;
130 static void 214 owner->host = (char *) xmalloc (len + 1);
131 fill_in_lock_file_name (REGISTER char *lockfile, REGISTER Lisp_Object fn) 215 strncpy (owner->host, at + 1, len);
132 /* fn must be a Lisp_String! */ 216 owner->host[len] = 0;
133 { 217
134 REGISTER char *p; 218 /* We're done looking at the link info. */
135 219 xfree (lfinfo);
136 CHECK_STRING (Vlock_directory); 220
137 221 /* On current host? */
138 strcpy (lockfile, (char *) XSTRING_DATA (Vlock_directory)); 222 if (STRINGP (Fsystem_name ())
139 223 && strcmp (owner->host, XSTRING_DATA(Fsystem_name ())) == 0)
140 p = lockfile + strlen (lockfile); 224 {
141 225 if (owner->pid == getpid ())
142 if (p == lockfile /* lock-directory is empty?? */ 226 ret = 2; /* We own it. */
143 || *(p - 1) != '/') /* in case lock-directory doesn't end in / */ 227 else if (owner->pid > 0
144 { 228 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
145 *p = '/'; 229 ret = 1; /* An existing process on this machine owns it. */
146 p++; 230 /* The owner process is dead or has a strange pid (<=0), so try to
147 } 231 zap the lockfile. */
148 232 else if (unlink (lfname) < 0)
149 strcpy (p, (char *) XSTRING_DATA (fn)); 233 ret = -1;
150 234 else
151 for (; *p; p++) 235 ret = 0;
152 { 236 }
153 if (*p == '/') 237 else
154 *p = '!'; 238 { /* If we wanted to support the check for stale locks on remote machines,
155 } 239 here's where we'd do it. */
156 } 240 ret = 1;
157 #endif /* !defined HAVE_LONG_FILE_NAMES */ 241 }
158 242
159 static Lisp_Object 243 /* Avoid garbage. */
160 lock_file_owner_name (CONST char *lfname) 244 if (local_owner || ret <= 0)
161 { 245 {
162 struct stat s; 246 FREE_LOCK_INFO (*owner);
163 struct passwd *the_pw = 0; 247 }
164 248 return ret;
165 if (lstat (lfname, &s) == 0) 249 }
166 the_pw = getpwuid (s.st_uid); 250
167 return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name)); 251 /* Lock the lock named LFNAME if possible.
168 } 252 Return 0 in that case.
169 253 Return positive if some other process owns the lock, and info about
170 254 that process in CLASHER.
171 /* lock_file locks file fn, 255 Return -1 if cannot lock for any other reason. */
256
257 static int
258 lock_if_free (lock_info_type *clasher, char *lfname)
259 {
260 if (lock_file_1 (lfname, 0) == 0)
261 {
262 int locker;
263
264 if (errno != EEXIST)
265 return -1;
266
267 locker = current_lock_owner (clasher, lfname);
268 if (locker == 2)
269 {
270 FREE_LOCK_INFO (*clasher);
271 return 0; /* We ourselves locked it. */
272 }
273 else if (locker == 1)
274 return 1; /* Someone else has it. */
275
276 return -1; /* Something's wrong. */
277 }
278 return 0;
279 }
280
281 /* lock_file locks file FN,
172 meaning it serves notice on the world that you intend to edit that file. 282 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 283 This should be done only when about to modify a file-visiting
174 buffer previously unmodified. 284 buffer previously unmodified.
175 Do not (normally) call lock_buffer for a buffer already modified, 285 Do not (normally) call this for a buffer already modified,
176 as either the file is already locked, or the user has already 286 as either the file is already locked, or the user has already
177 decided to go ahead without locking. 287 decided to go ahead without locking.
178 288
179 When lock_buffer returns, either the lock is locked for us, 289 When this returns, either the lock is locked for us,
180 or the user has said to go ahead without locking. 290 or the user has said to go ahead without locking.
181 291
182 If the file is locked by someone else, lock_buffer calls 292 If the file is locked by someone else, this calls
183 ask-user-about-lock (a Lisp function) with two arguments, 293 ask-user-about-lock (a Lisp function) with two arguments,
184 the file name and the name of the user who did the locking. 294 the file name and info about the user who did the locking.
185 This function can signal an error, or return t meaning 295 This function can signal an error, or return t meaning
186 take away the lock, or return nil meaning ignore the lock. */ 296 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 297
197 void 298 void
198 lock_file (Lisp_Object fn) 299 lock_file (Lisp_Object fn)
199 { 300 {
200 /* This function can GC. */ 301 /* This function can GC. */
201 /* dmoore - and can destroy current_buffer and all sorts of other 302 /* dmoore - and can destroy current_buffer and all sorts of other
202 mean nasty things with pointy teeth. If you call this make sure 303 mean nasty things with pointy teeth. If you call this make sure
203 you protect things right. */ 304 you protect things right. */
204 305 /* Somebody updated the code in this function and removed the previous
205 REGISTER Lisp_Object attack, orig_fn; 306 comment. -slb */
206 REGISTER char *lfname; 307
207 struct gcpro gcpro1, gcpro2; 308 register Lisp_Object attack, orig_fn;
208 Lisp_Object subject_buf = Qnil; 309 register char *lfname, *locker;
209 310 lock_info_type lock_info;
210 if (NILP (Vlock_directory) || NILP (Vsuperlock_file)) 311 struct gcpro gcpro1,gcpro2;
211 return; 312 Lisp_Object subject_buf;
212 CHECK_STRING (fn);
213 CHECK_STRING (Vlock_directory);
214 313
215 GCPRO2 (fn, subject_buf); 314 GCPRO2 (fn, subject_buf);
216 orig_fn = fn; 315 orig_fn = fn;
217 fn = Fexpand_file_name (fn, Qnil); 316 fn = Fexpand_file_name (fn, Qnil);
218 317
219 /* Create the name of the lock-file for file fn */ 318 /* Create the name of the lock-file for file fn */
220 MAKE_LOCK_NAME (lfname, fn); 319 MAKE_LOCK_NAME (lfname, fn);
221 320
222 /* See if this file is visited and has changed on disk since it was 321 /* See if this file is visited and has changed on disk since it was
223 visited. */ 322 visited. */
224 subject_buf = Fget_file_buffer (fn); 323 {
225 if (!NILP (subject_buf) 324 subject_buf = get_truename_buffer (orig_fn);
226 && NILP (Fverify_visited_file_modtime (subject_buf)) 325 if (!NILP (subject_buf)
227 && !NILP (Ffile_exists_p (fn))) 326 && NILP (Fverify_visited_file_modtime (subject_buf))
228 call1_in_buffer (XBUFFER (subject_buf), 327 && !NILP (Ffile_exists_p (fn)))
229 Qask_user_about_supersession_threat, fn); 328 call1_in_buffer (XBUFFER(subject_buf),
329 Qask_user_about_supersession_threat, fn);
330 }
230 331
231 /* Try to lock the lock. */ 332 /* Try to lock the lock. */
232 if (lock_if_free (lfname) <= 0) 333 if (lock_if_free (&lock_info, lfname) <= 0)
233 /* Return now if we have locked it, or if lock dir does not exist */ 334 /* Return now if we have locked it, or if lock creation failed */
234 goto done; 335 goto done;
235 336
236 /* Else consider breaking the lock */ 337 /* Else consider breaking the lock */
338 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
339 + LOCK_PID_MAX + 9);
340 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
341 lock_info.pid);
342 FREE_LOCK_INFO (lock_info);
343
237 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) : 344 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
238 current_buffer, Qask_user_about_lock, fn, 345 current_buffer, Qask_user_about_lock , fn,
239 lock_file_owner_name (lfname)); 346 build_string (locker));
240 if (!NILP (attack)) 347 if (!NILP (attack))
241 /* User says take the lock */ 348 /* User says take the lock */
242 { 349 {
243 CHECK_STRING (Vsuperlock_file); 350 lock_file_1 (lfname, 1);
244 lock_superlock (lfname);
245 lock_file_1 (lfname, O_WRONLY);
246 unlink ((char *) XSTRING_DATA (Vsuperlock_file));
247 goto done; 351 goto done;
248 } 352 }
249 /* User says ignore the lock */ 353 /* User says ignore the lock */
250 done: 354 done:
251 UNGCPRO; 355 UNGCPRO;
252 } 356 }
253 357
254
255 /* Lock the lock file named LFNAME.
256 If MODE is O_WRONLY, we do so even if it is already locked.
257 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
258 Return 1 if successful, 0 if not. */
259
260 static int
261 lock_file_1 (CONST char *lfname, int mode)
262 {
263 REGISTER int fd;
264 char buf[20];
265
266 if ((fd = open (lfname, mode, 0666)) >= 0)
267 {
268 #if defined(WINDOWSNT)
269 chmod(lfname, _S_IREAD|_S_IWRITE);
270 #elif defined(USG)
271 chmod (lfname, 0666);
272 #else
273 fchmod (fd, 0666);
274 #endif
275 sprintf (buf, "%ld ", (long) getpid ());
276 write (fd, buf, strlen (buf));
277 close (fd);
278 return 1;
279 }
280 else
281 return 0;
282 }
283
284 /* Lock the lock named LFNAME if possible.
285 Return 0 in that case.
286 Return positive if lock is really locked by someone else.
287 Return -1 if cannot lock for any other reason. */
288
289 static int
290 lock_if_free (CONST char *lfname)
291 {
292 REGISTER int clasher;
293
294 while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
295 {
296 if (errno != EEXIST)
297 return -1;
298 clasher = current_lock_owner (lfname);
299 if (clasher != 0)
300 if (clasher != getpid ())
301 return (clasher);
302 else return (0);
303 /* Try again to lock it */
304 }
305 return 0;
306 }
307
308 /* Return the pid of the process that claims to own the lock file LFNAME,
309 or 0 if nobody does or the lock is obsolete,
310 or -1 if something is wrong with the locking mechanism. */
311
312 static int
313 current_lock_owner (CONST char *lfname)
314 {
315 int owner = current_lock_owner_1 (lfname);
316 if (owner == 0 && errno == ENOENT)
317 return (0);
318 /* Is it locked by a process that exists? */
319 if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
320 return (owner);
321 if (unlink (lfname) < 0)
322 return (-1);
323 return (0);
324 }
325
326 static int
327 current_lock_owner_1 (CONST char *lfname)
328 {
329 REGISTER int fd;
330 char buf[20];
331 int tem;
332
333 fd = open (lfname, O_RDONLY, 0666);
334 if (fd < 0)
335 return 0;
336 tem = read (fd, buf, sizeof buf);
337 close (fd);
338 return (tem <= 0 ? 0 : atoi (buf));
339 }
340
341
342 void 358 void
343 unlock_file (Lisp_Object fn) 359 unlock_file (Lisp_Object fn)
344 { 360 {
345 /* This function can GC. */ 361 register char *lfname;
346 /* dmoore - and can destroy current_buffer and all sorts of other
347 mean nasty things with pointy teeth. If you call this make sure
348 you protect things right. */
349
350 REGISTER char *lfname;
351 if (NILP (Vlock_directory) || NILP (Vsuperlock_file)) return;
352 CHECK_STRING (fn);
353 CHECK_STRING (Vlock_directory);
354 CHECK_STRING (Vsuperlock_file);
355 362
356 fn = Fexpand_file_name (fn, Qnil); 363 fn = Fexpand_file_name (fn, Qnil);
357 364
358 MAKE_LOCK_NAME (lfname, fn); 365 MAKE_LOCK_NAME (lfname, fn);
359 366
360 lock_superlock (lfname); 367 if (current_lock_owner (0, lfname) == 2)
361
362 if (current_lock_owner_1 (lfname) == getpid ())
363 unlink (lfname); 368 unlink (lfname);
364
365 unlink ((char *) XSTRING_DATA (Vsuperlock_file));
366 }
367
368 static void
369 lock_superlock (CONST char *lfname)
370 {
371 REGISTER int i, fd;
372 DIR *lockdir;
373
374 for (i = -20; i < 0 &&
375 (fd = open ((char *) XSTRING_DATA (Vsuperlock_file),
376 O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
377 i++)
378 {
379 if (errno != EEXIST)
380 return;
381
382 /* This seems to be necessary to prevent Emacs from hanging when the
383 competing process has already deleted the superlock, but it's still
384 in the NFS cache. So we force NFS to synchronize the cache. */
385 lockdir = opendir ((char *) XSTRING_DATA (Vlock_directory));
386 if (lockdir)
387 closedir (lockdir);
388
389 emacs_sleep (1);
390 }
391 if (fd >= 0)
392 {
393 #if defined(WINDOWSNT)
394 chmod(lfname, _S_IREAD|_S_IWRITE);
395 #elif defined(USG)
396 chmod ((char *) XSTRING_DATA (Vsuperlock_file), 0666);
397 #else
398 fchmod (fd, 0666);
399 #endif
400 write (fd, lfname, strlen (lfname));
401 close (fd);
402 }
403 } 369 }
404 370
405 void 371 void
406 unlock_all_files (void) 372 unlock_all_files ()
407 { 373 {
408 /* This function can GC. */ 374 register Lisp_Object tail;
409 375 register struct buffer *b;
410 Lisp_Object tail; 376
411 REGISTER struct buffer *b; 377 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
412 struct gcpro gcpro1;
413
414 GCPRO1 (tail);
415 for (tail = Vbuffer_alist; GC_CONSP (tail);
416 tail = XCDR (tail))
417 { 378 {
418 b = XBUFFER (XCDR (XCAR (tail))); 379 b = XBUFFER (XCDR (XCAR (tail)));
419 if (STRINGP (b->file_truename) && 380 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
420 BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
421 unlock_file (b->file_truename); 381 unlock_file (b->file_truename);
422 } 382 }
423 UNGCPRO; 383 }
424 }
425
426 384
427 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /* 385 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
428 Lock FILE, if current buffer is modified. 386 Lock FILE, if current buffer is modified.\n\
429 FILE defaults to current buffer's visited file, 387 FILE defaults to current buffer's visited file,\n\
430 or else nothing is done if current buffer isn't visiting a file. 388 or else nothing is done if current buffer isn't visiting a file.
431 */ 389 */
432 (fn)) 390 (file))
433 { 391 {
434 /* This function can GC */ 392 if (NILP (file))
435 /* dmoore - and can destroy current_buffer and all sorts of other 393 file = current_buffer->file_truename;
436 mean nasty things with pointy teeth. If you call this make sure 394 CHECK_STRING (file);
437 you protect things right. */
438
439 if (NILP (fn))
440 fn = current_buffer->file_truename;
441 CHECK_STRING (fn);
442 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) 395 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
443 && !NILP (fn)) 396 && !NILP (file))
444 lock_file (fn); 397 lock_file (file);
445 return Qnil; 398 return Qnil;
446 } 399 }
447 400
448 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /* 401 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
449 Unlock the file visited in the current buffer, 402 Unlock the file visited in the current buffer,
460 && STRINGP (current_buffer->file_truename)) 413 && STRINGP (current_buffer->file_truename))
461 unlock_file (current_buffer->file_truename); 414 unlock_file (current_buffer->file_truename);
462 return Qnil; 415 return Qnil;
463 } 416 }
464 417
465
466 /* Unlock the file visited in buffer BUFFER. */ 418 /* Unlock the file visited in buffer BUFFER. */
419
467 420
468 void 421 void
469 unlock_buffer (struct buffer *buffer) 422 unlock_buffer (struct buffer *buffer)
470 { 423 {
471 /* This function can GC */ 424 /* This function can GC */
476 && STRINGP (buffer->file_truename)) 429 && STRINGP (buffer->file_truename))
477 unlock_file (buffer->file_truename); 430 unlock_file (buffer->file_truename);
478 } 431 }
479 432
480 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /* 433 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
481 Return nil if the FILENAME is not locked, 434 Return nil if the FILENAME is not locked,\n\
482 t if it is locked by you, else a string of the name of the locker. 435 t if it is locked by you, else a string of the name of the locker.
483 */ 436 */
484 (fn)) 437 (filename))
485 { 438 {
486 /* This function can GC */ 439 Lisp_Object ret;
487 REGISTER char *lfname; 440 register char *lfname;
488 int owner; 441 int owner;
489 442 lock_info_type locker;
490 if (NILP (Vlock_directory) || NILP (Vsuperlock_file)) 443
491 return Qnil; 444 filename = Fexpand_file_name (filename, Qnil);
492 CHECK_STRING (Vlock_directory); 445
493 446 MAKE_LOCK_NAME (lfname, filename);
494 fn = Fexpand_file_name (fn, Qnil); 447
495 448 owner = current_lock_owner (&locker, lfname);
496 MAKE_LOCK_NAME (lfname, fn);
497
498 owner = current_lock_owner (lfname);
499 if (owner <= 0) 449 if (owner <= 0)
500 return Qnil; 450 ret = Qnil;
501 else if (owner == getpid ()) 451 else if (owner == 2)
502 return Qt; 452 ret = Qt;
503 453 else
504 return lock_file_owner_name (lfname); 454 ret = build_string (locker.user);
505 } 455
456 if (owner > 0)
457 FREE_LOCK_INFO (locker);
458
459 return ret;
460 }
461
462
463 /* Initialization functions. */
506 464
507 void 465 void
508 syms_of_filelock (void) 466 syms_of_filelock (void)
509 { 467 {
510 /* This function can GC */ 468 /* This function can GC */
515 defsymbol (&Qask_user_about_supersession_threat, 473 defsymbol (&Qask_user_about_supersession_threat,
516 "ask-user-about-supersession-threat"); 474 "ask-user-about-supersession-threat");
517 defsymbol (&Qask_user_about_lock, "ask-user-about-lock"); 475 defsymbol (&Qask_user_about_lock, "ask-user-about-lock");
518 } 476 }
519 477
520 void 478
521 vars_of_filelock (void) 479 #endif /* CLASH_DETECTION */
522 {
523 DEFVAR_LISP ("lock-directory", &Vlock_directory /*
524 Don't change this
525 */ );
526 Vlock_directory = Qnil;
527 DEFVAR_LISP ("superlock-file", &Vsuperlock_file /*
528 Don't change this
529 */ );
530 Vsuperlock_file = Qnil;
531 }
532
533 void
534 complex_vars_of_filelock (void)
535 {
536 DEFVAR_LISP ("configure-superlock-file", &Vconfigure_superlock_file /*
537 For internal use by the build procedure only.
538 configure's idea of what SUPERLOCK-FILE will be.
539 */ );
540 #ifdef PATH_SUPERLOCK
541 Vconfigure_superlock_file = build_string (PATH_SUPERLOCK);
542 #else
543 Vconfigure_superlock_file = Qnil;
544 #endif
545 /* All the rest done dynamically by startup.el */
546 }