Mercurial > hg > xemacs-beta

comparison src/filelock.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 9d177e8d4150
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
32 32
33 Lisp_Object Qask_user_about_supersession_threat; 33 Lisp_Object Qask_user_about_supersession_threat;
34 Lisp_Object Qask_user_about_lock; 34 Lisp_Object Qask_user_about_lock;
35 35
36 #ifdef CLASH_DETECTION 36 #ifdef CLASH_DETECTION
37 37
38 /* The strategy: to lock a file FN, create a symlink .#FN in FN's 38 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
39 directory, with link data `user@host.pid'. This avoids a single 39 directory, with link data `user@host.pid'. This avoids a single
40 mount (== failure) point for lock files. 40 mount (== failure) point for lock files.
41 41
42 When the host in the lock data is the current host, we can check if 42 When the host in the lock data is the current host, we can check if
43 the pid is valid with kill. 43 the pid is valid with kill.
44 44
45 Otherwise, we could look at a separate file that maps hostnames to 45 Otherwise, we could look at a separate file that maps hostnames to
46 reboot times to see if the remote pid can possibly be valid, since we 46 reboot times to see if the remote pid can possibly be valid, since we
47 don't want Emacs to have to communicate via pipes or sockets or 47 don't want Emacs to have to communicate via pipes or sockets or
48 whatever to other processes, either locally or remotely; rms says 48 whatever to other processes, either locally or remotely; rms says
49 that's too unreliable. Hence the separate file, which could 49 that's too unreliable. Hence the separate file, which could
61 didn't seem worth the complication. 61 didn't seem worth the complication.
62 62
63 Similarly, we don't worry about a possible 14-character limit on 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 64 file names, because those are all the same systems that don't have
65 symlinks. 65 symlinks.
66 66
67 This is compatible with the locking scheme used by Interleaf (which 67 This is compatible with the locking scheme used by Interleaf (which
68 has contributed this implementation for Emacs), and was designed by 68 has contributed this implementation for Emacs), and was designed by
69 Ethan Jacobson, Kimbo Mundy, and others. 69 Ethan Jacobson, Kimbo Mundy, and others.
70 70
71 --karl@cs.umb.edu/karl@hq.ileaf.com. */ 71 --karl@cs.umb.edu/karl@hq.ileaf.com. */
72
73 /* Note that muleization is provided by using mule-encapsulated
74 versions of the system calls we use like symlink(), unlink(), etc... */
72 75
73 76
74 /* Here is the structure that stores information about a lock. */ 77 /* Here is the structure that stores information about a lock. */
75 78
76 typedef struct 79 typedef struct
88 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0) 91 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
89 92
90 /* Write the name of the lock file for FN into LFNAME. Length will be 93 /* 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. */ 94 that of FN plus two more for the leading `.#' plus one for the null. */
92 #define MAKE_LOCK_NAME(lock, file) \ 95 #define MAKE_LOCK_NAME(lock, file) \
93 (lock = (char *) alloca (XSTRING_LENGTH(file) + 2 + 1), \ 96 (lock = (char *) alloca (XSTRING_LENGTH (file) + 2 + 1), \
94 fill_in_lock_file_name (lock, (file))) 97 fill_in_lock_file_name ((Bufbyte *) (lock), (file)))
95 98
96 static void 99 static void
97 fill_in_lock_file_name (lockfile, fn) 100 fill_in_lock_file_name (Bufbyte *lockfile, Lisp_Object fn)
98 register char *lockfile; 101 {
99 register Lisp_Object fn; 102 Bufbyte *file_name = XSTRING_DATA (fn);
100 { 103 Bufbyte *p;
101 register char *p; 104 size_t dirlen;
102 105
103 strcpy (lockfile, XSTRING_DATA(fn)); 106 for (p = file_name + XSTRING_LENGTH (fn) - 1;
104 107 p > file_name && !IS_ANY_SEP (p[-1]);
105 /* Shift the nondirectory part of the file name (including the null) 108 p--)
106 right two characters. Here is one of the places where we'd have to 109 ;
107 do something to support 14-character-max file names. */ 110 dirlen = p - file_name;
108 for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--) 111
109 p[2] = *p; 112 memcpy (lockfile, file_name, dirlen);
110 113 p = lockfile + dirlen;
111 /* Insert the `.#'. */ 114 *(p++) = '.';
112 p[1] = '.'; 115 *(p++) = '#';
113 p[2] = '#'; 116 memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen + 1);
114 } 117 }
115 118
116 /* Lock the lock file named LFNAME. 119 /* Lock the lock file named LFNAME.
117 If FORCE is nonzero, we do so even if it is already locked. 120 If FORCE is nonzero, we do so even if it is already locked.
118 Return 1 if successful, 0 if not. */ 121 Return 1 if successful, 0 if not. */
119 122
120 static int 123 static int
121 lock_file_1 (char *lfname,int force) 124 lock_file_1 (char *lfname, int force)
122 { 125 {
123 register int err; 126 /* Does not GC. */
124 char *user_name; 127 int err;
128 char *lock_info_str;
125 char *host_name; 129 char *host_name;
126 char *lock_info_str; 130 char *user_name = user_login_name (NULL);
127 131
128 if (STRINGP (Fuser_login_name (Qnil))) 132 if (user_name == NULL)
129 user_name = (char *) XSTRING_DATA (Fuser_login_name (Qnil));
130 else
131 user_name = ""; 133 user_name = "";
132 if (STRINGP (Fsystem_name ())) 134
133 host_name = (char *) XSTRING_DATA (Fsystem_name ()); 135 if (STRINGP (Vsystem_name))
136 host_name = (char *) XSTRING_DATA (Vsystem_name);
134 else 137 else
135 host_name = ""; 138 host_name = "";
139
136 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name) 140 lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
137 + LOCK_PID_MAX + 5); 141 + LOCK_PID_MAX + 5);
138 142
139 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name, 143 sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
140 (unsigned long) getpid ()); 144 (unsigned long) getpid ());
141 145
142 err = symlink (lock_info_str, lfname); 146 err = symlink (lock_info_str, lfname);
143 if (errno == EEXIST && force) 147 if (err != 0 && errno == EEXIST && force)
144 { 148 {
145 unlink (lfname); 149 unlink (lfname);
146 err = symlink (lock_info_str, lfname); 150 err = symlink (lock_info_str, lfname);
147 } 151 }
148 152
155 or -1 if something is wrong with the locking mechanism. */ 159 or -1 if something is wrong with the locking mechanism. */
156 160
157 static int 161 static int
158 current_lock_owner (lock_info_type *owner, char *lfname) 162 current_lock_owner (lock_info_type *owner, char *lfname)
159 { 163 {
160 int o, p, len, ret; 164 /* Does not GC. */
165 int len, ret;
161 int local_owner = 0; 166 int local_owner = 0;
162 char *at, *dot; 167 char *at, *dot;
163 char *lfinfo = 0; 168 char *lfinfo = 0;
164 int bufsize = 50; 169 int bufsize = 50;
165 /* Read arbitrarily-long contents of symlink. Similar code in 170 /* Read arbitrarily-long contents of symlink. Similar code in
169 bufsize *= 2; 174 bufsize *= 2;
170 lfinfo = (char *) xrealloc (lfinfo, bufsize); 175 lfinfo = (char *) xrealloc (lfinfo, bufsize);
171 len = readlink (lfname, lfinfo, bufsize); 176 len = readlink (lfname, lfinfo, bufsize);
172 } 177 }
173 while (len >= bufsize); 178 while (len >= bufsize);
174 179
175 /* If nonexistent lock file, all is well; otherwise, got strange error. */ 180 /* If nonexistent lock file, all is well; otherwise, got strange error. */
176 if (len == -1) 181 if (len == -1)
177 { 182 {
178 xfree (lfinfo); 183 xfree (lfinfo);
179 return errno == ENOENT ? 0 : -1; 184 return errno == ENOENT ? 0 : -1;
180 } 185 }
181 186
182 /* Link info exists, so `len' is its length. Null terminate. */ 187 /* Link info exists, so `len' is its length. Null terminate. */
183 lfinfo[len] = 0; 188 lfinfo[len] = 0;
184 189
185 /* Even if the caller doesn't want the owner info, we still have to 190 /* Even if the caller doesn't want the owner info, we still have to
186 read it to determine return value, so allocate it. */ 191 read it to determine return value, so allocate it. */
187 if (!owner) 192 if (!owner)
188 { 193 {
189 owner = (lock_info_type *) alloca (sizeof (lock_info_type)); 194 owner = (lock_info_type *) alloca (sizeof (lock_info_type));
190 local_owner = 1; 195 local_owner = 1;
191 } 196 }
192 197
193 /* Parse USER@HOST.PID. If can't parse, return -1. */ 198 /* Parse USER@HOST.PID. If can't parse, return -1. */
194 /* The USER is everything before the first @. */ 199 /* The USER is everything before the first @. */
195 at = strchr (lfinfo, '@'); 200 at = strchr (lfinfo, '@');
196 dot = strrchr (lfinfo, '.'); 201 dot = strrchr (lfinfo, '.');
197 if (!at || !dot) { 202 if (!at || !dot) {
200 } 205 }
201 len = at - lfinfo; 206 len = at - lfinfo;
202 owner->user = (char *) xmalloc (len + 1); 207 owner->user = (char *) xmalloc (len + 1);
203 strncpy (owner->user, lfinfo, len); 208 strncpy (owner->user, lfinfo, len);
204 owner->user[len] = 0; 209 owner->user[len] = 0;
205 210
206 /* The PID is everything after the last `.'. */ 211 /* The PID is everything after the last `.'. */
207 owner->pid = atoi (dot + 1); 212 owner->pid = atoi (dot + 1);
208 213
209 /* The host is everything in between. */ 214 /* The host is everything in between. */
210 len = dot - at - 1; 215 len = dot - at - 1;
212 strncpy (owner->host, at + 1, len); 217 strncpy (owner->host, at + 1, len);
213 owner->host[len] = 0; 218 owner->host[len] = 0;
214 219
215 /* We're done looking at the link info. */ 220 /* We're done looking at the link info. */
216 xfree (lfinfo); 221 xfree (lfinfo);
217 222
218 /* On current host? */ 223 /* On current host? */
219 if (STRINGP (Fsystem_name ()) 224 if (STRINGP (Fsystem_name ())
220 && strcmp (owner->host, XSTRING_DATA(Fsystem_name ())) == 0) 225 && strcmp (owner->host, (char *) XSTRING_DATA (Fsystem_name ())) == 0)
221 { 226 {
222 if (owner->pid == getpid ()) 227 if (owner->pid == getpid ())
223 ret = 2; /* We own it. */ 228 ret = 2; /* We own it. */
224 else if (owner->pid > 0 229 else if (owner->pid > 0
225 && (kill (owner->pid, 0) >= 0 || errno == EPERM)) 230 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
234 else 239 else
235 { /* If we wanted to support the check for stale locks on remote machines, 240 { /* If we wanted to support the check for stale locks on remote machines,
236 here's where we'd do it. */ 241 here's where we'd do it. */
237 ret = 1; 242 ret = 1;
238 } 243 }
239 244
240 /* Avoid garbage. */ 245 /* Avoid garbage. */
241 if (local_owner || ret <= 0) 246 if (local_owner || ret <= 0)
242 { 247 {
243 FREE_LOCK_INFO (*owner); 248 FREE_LOCK_INFO (*owner);
244 } 249 }
252 Return -1 if cannot lock for any other reason. */ 257 Return -1 if cannot lock for any other reason. */
253 258
254 static int 259 static int
255 lock_if_free (lock_info_type *clasher, char *lfname) 260 lock_if_free (lock_info_type *clasher, char *lfname)
256 { 261 {
262 /* Does not GC. */
257 if (lock_file_1 (lfname, 0) == 0) 263 if (lock_file_1 (lfname, 0) == 0)
258 { 264 {
259 int locker; 265 int locker;
260 266
261 if (errno != EEXIST) 267 if (errno != EEXIST)
262 return -1; 268 return -1;
263 269
264 locker = current_lock_owner (clasher, lfname); 270 locker = current_lock_owner (clasher, lfname);
265 if (locker == 2) 271 if (locker == 2)
266 { 272 {
267 FREE_LOCK_INFO (*clasher); 273 FREE_LOCK_INFO (*clasher);
268 return 0; /* We ourselves locked it. */ 274 return 0; /* We ourselves locked it. */
293 take away the lock, or return nil meaning ignore the lock. */ 299 take away the lock, or return nil meaning ignore the lock. */
294 300
295 void 301 void
296 lock_file (Lisp_Object fn) 302 lock_file (Lisp_Object fn)
297 { 303 {
298 /* This function can GC. */ 304 /* This function can GC. GC checked 7-11-00 ben */
299 /* dmoore - and can destroy current_buffer and all sorts of other 305 /* dmoore - and can destroy current_buffer and all sorts of other
300 mean nasty things with pointy teeth. If you call this make sure 306 mean nasty things with pointy teeth. If you call this make sure
301 you protect things right. */ 307 you protect things right. */
302 /* Somebody updated the code in this function and removed the previous 308 /* Somebody updated the code in this function and removed the previous
303 comment. -slb */ 309 comment. -slb */
304 310
305 register Lisp_Object attack, orig_fn; 311 register Lisp_Object attack, orig_fn;
306 register char *lfname, *locker; 312 register char *lfname, *locker;
307 lock_info_type lock_info; 313 lock_info_type lock_info;
320 { 326 {
321 subject_buf = get_truename_buffer (orig_fn); 327 subject_buf = get_truename_buffer (orig_fn);
322 if (!NILP (subject_buf) 328 if (!NILP (subject_buf)
323 && NILP (Fverify_visited_file_modtime (subject_buf)) 329 && NILP (Fverify_visited_file_modtime (subject_buf))
324 && !NILP (Ffile_exists_p (fn))) 330 && !NILP (Ffile_exists_p (fn)))
325 call1_in_buffer (XBUFFER(subject_buf), 331 call1_in_buffer (XBUFFER (subject_buf),
326 Qask_user_about_supersession_threat, fn); 332 Qask_user_about_supersession_threat, fn);
327 } 333 }
328 334
329 /* Try to lock the lock. */ 335 /* Try to lock the lock. */
330 if (lock_if_free (&lock_info, lfname) <= 0) 336 if (lock_if_free (&lock_info, lfname) <= 0)
331 /* Return now if we have locked it, or if lock creation failed */ 337 /* Return now if we have locked it, or if lock creation failed */
335 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host) 341 locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
336 + LOCK_PID_MAX + 9); 342 + LOCK_PID_MAX + 9);
337 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host, 343 sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
338 lock_info.pid); 344 lock_info.pid);
339 FREE_LOCK_INFO (lock_info); 345 FREE_LOCK_INFO (lock_info);
340 346
341 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) : 347 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
342 current_buffer, Qask_user_about_lock , fn, 348 current_buffer, Qask_user_about_lock , fn,
343 build_string (locker)); 349 build_string (locker));
344 if (!NILP (attack)) 350 if (!NILP (attack))
345 /* User says take the lock */ 351 /* User says take the lock */
353 } 359 }
354 360
355 void 361 void
356 unlock_file (Lisp_Object fn) 362 unlock_file (Lisp_Object fn)
357 { 363 {
364 /* This can GC */
358 register char *lfname; 365 register char *lfname;
366 struct gcpro gcpro1;
367
368 GCPRO1 (fn);
359 369
360 fn = Fexpand_file_name (fn, Qnil); 370 fn = Fexpand_file_name (fn, Qnil);
361 371
362 MAKE_LOCK_NAME (lfname, fn); 372 MAKE_LOCK_NAME (lfname, fn);
363 373
364 if (current_lock_owner (0, lfname) == 2) 374 if (current_lock_owner (0, lfname) == 2)
365 unlink (lfname); 375 unlink (lfname);
376
377 UNGCPRO;
366 } 378 }
367 379
368 void 380 void
369 unlock_all_files () 381 unlock_all_files (void)
370 { 382 {
371 register Lisp_Object tail; 383 register Lisp_Object tail;
372 register struct buffer *b;
373 384
374 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) 385 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
375 { 386 {
376 b = XBUFFER (XCDR (XCAR (tail))); 387 struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
377 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) 388 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
378 unlock_file (b->file_truename); 389 unlock_file (b->file_truename);
379 } 390 }
380 } 391 }
381 392
382 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /* 393 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
383 Lock FILE, if current buffer is modified.\n\ 394 Lock FILE, if current buffer is modified.
384 FILE defaults to current buffer's visited file,\n\ 395 FILE defaults to current buffer's visited file,
385 or else nothing is done if current buffer isn't visiting a file. 396 or else nothing is done if current buffer isn't visiting a file.
386 */ 397 */
387 (file)) 398 (file))
388 { 399 {
389 if (NILP (file)) 400 if (NILP (file))
390 file = current_buffer->file_truename; 401 file = current_buffer->file_truename;
391 CHECK_STRING (file); 402 CHECK_STRING (file);
392 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) 403 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
426 && STRINGP (buffer->file_truename)) 437 && STRINGP (buffer->file_truename))
427 unlock_file (buffer->file_truename); 438 unlock_file (buffer->file_truename);
428 } 439 }
429 440
430 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /* 441 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
431 Return nil if the FILENAME is not locked,\n\ 442 Return nil if the FILENAME is not locked,
432 t if it is locked by you, else a string of the name of the locker. 443 t if it is locked by you, else a string of the name of the locker.
433 */ 444 */
434 (filename)) 445 (filename))
435 { 446 {
436 Lisp_Object ret; 447 Lisp_Object ret;
437 register char *lfname; 448 register char *lfname;
438 int owner; 449 int owner;
439 lock_info_type locker; 450 lock_info_type locker;
451 struct gcpro gcpro1;
452
453 GCPRO1 (filename);
440 454
441 filename = Fexpand_file_name (filename, Qnil); 455 filename = Fexpand_file_name (filename, Qnil);
442 456
443 MAKE_LOCK_NAME (lfname, filename); 457 MAKE_LOCK_NAME (lfname, filename);
444 458
451 ret = build_string (locker.user); 465 ret = build_string (locker.user);
452 466
453 if (owner > 0) 467 if (owner > 0)
454 FREE_LOCK_INFO (locker); 468 FREE_LOCK_INFO (locker);
455 469
470 UNGCPRO;
471
456 return ret; 472 return ret;
457 } 473 }
458 474
459 475
460 /* Initialization functions. */ 476 /* Initialization functions. */